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