1# 2# nice.test 3# 4# Tests for the nice command. 5#--------------------------------------------------------------------------- 6# Copyright 1993-1999 Karl Lehenbauer and Mark Diekhans. 7# 8# Permission to use, copy, modify, and distribute this software and its 9# documentation for any purpose and without fee is hereby granted, provided 10# that the above copyright notice appear in all copies. Karl Lehenbauer and 11# Mark Diekhans make no representations about the suitability of this 12# software for any purpose. It is provided "as is" without express or 13# implied warranty. 14#------------------------------------------------------------------------------ 15# $Id: 16#------------------------------------------------------------------------------ 17# 18 19if {[cequal [info procs Test] {}]} { 20 source [file join [file dirname [info script]] testlib.tcl] 21} 22 23if [cequal $tcl_platform(platform) windows] { 24 echo " * The nice command has not been ported to Win32" 25 return 26} 27 28# 29# Fork without exec will not work under Tk, skip this test 30# 31if {[info exists tk_version]} { 32 puts "*************************************************************" 33 puts "Nice tests are constructed in a way that does not work" 34 puts "under Tk. Test skipped." 35 puts "*************************************************************" 36 return 37} 38 39# 40# Right now, we depend on the base priority being zero. 41# 42if {[nice] != 0} { 43 puts "*************************************************************" 44 puts "Nice priority is [nice], not zero. May cause some failures." 45 puts "(but everything is probably ok)" 46 puts "*************************************************************" 47} 48 49set niceBase [nice] 50 51test nice-1.1 {nice tests} { 52 list [catch {nice 0 1} msg] $msg 53} {1 {wrong # args: nice ?priorityincr?}} 54 55test nice-1.2 {nice tests} { 56 nice 0 57} $niceBase 58 59# 60# Since you can't nice back up unless you're root, we spawn a child process 61# to run the nice tests. 62# 63 64flush stdout 65flush stderr 66set pid [fork] 67 68# 69# Parent waits for child to complete. 70# 71if {$pid > 0} { 72 wait $pid 73 74 # cleanup 75 ::tcltest::cleanupTests 76 return 77} 78 79test nice-1.4 {nice tests} { 80 list [nice 3] [nice] 81} [list [expr $niceBase+3] [expr $niceBase+3]] 82 83test nice-1.5 {nice tests} { 84 list [nice 4] [nice] 85} [list [expr $niceBase+3+4] [expr $niceBase+3+4]] 86 87test nice-1.7 {nice tests} {isNotRoot} { 88 set errList {{not owner} {permission denied} {not privileged} 89 {no permission match} {invalid argument}} 90 set stat [catch {nice -1} msg] 91 set msg [string tolower $msg] 92 if {![regexp {^failed to increment priority: (.*)$} $msg {} errmsg] || \ 93 ([lsearch $errList $errmsg] < 0)} { 94 set stat [list $stat $msg] 95 } 96 set stat 97} 1 98 99test nice-1.8 {nice tests} {isRoot} { 100 list [nice -1] [nice] 101} [list [expr $niceBase+3+4-1] [expr $niceBase+3+4-1]] 102 103test nice-1.10 {nice tests} {isRoot} { 104 list [nice -9] [nice] 105} [list [expr $niceBase+3+4-1-9] [expr $niceBase+3+4-1-9]] 106 107test nice-1.11 {nice tests} {isRoot} { 108 list [nice -10] [nice] 109} [list [expr $niceBase+3+4-1-9-10] [expr $niceBase+3+4-1-9-10]] 110 111test nice-1.12 {nice tests} {isRoot} { 112 list [nice -1] [nice] 113} [list [expr $niceBase+3+4-1-9-10-1] [expr $niceBase+3+4-1-9-10-1]] 114 115# cleanup 116::tcltest::cleanupTests 117exit 118