home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / tests / nice.test < prev    next >
Encoding:
Text File  |  1994-07-16  |  2.9 KB  |  116 lines
  1. #
  2. # nice.test
  3. #
  4. # Tests for the nice command.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1993-1994 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.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. #
  22. # Fork without exec will not work under Tk, skip this test
  23. #
  24. if ![lempty [info commands button]] {
  25.     puts "*************************************************************"
  26.     puts "Nice tests are constructed in a way that does not work"
  27.     puts "under Tk.  Test skipped."
  28.     puts "*************************************************************"
  29.     puts ""
  30.     return
  31. }
  32.  
  33. #
  34. # Right now, we depend on the base priority being zero.
  35. #
  36. if {[nice] != 0} {
  37.     puts "*************************************************************"
  38.     puts "Nice priority is [nice], not zero.  May cause some failures."
  39.     puts "(but everything is probably ok)"
  40.     puts "*************************************************************"
  41.     puts ""
  42. }
  43.  
  44. set niceBase [nice]
  45.  
  46. Test nice-1.1 {nice tests} {
  47.     nice 0 1
  48. } 1 {wrong # args: nice ?priorityincr?}
  49.  
  50. Test nice-1.2 {nice tests} {
  51.     nice 0
  52. } 0 $niceBase
  53.  
  54. #
  55. # Since you can't nice back up unless you're root, we spawn a child process 
  56. # to run the nice tests.  
  57. #
  58.  
  59. flush stdout
  60. flush stderr
  61. set pid [fork]
  62.  
  63. #
  64. # Parent waits for child to complete.
  65. #
  66. if {$pid > 0} {
  67.     wait $pid
  68.     return
  69. }
  70.  
  71. Test nice-1.4 {nice tests} {
  72.     nice 3
  73. } 0 [expr $niceBase+3]
  74.  
  75. Test nice-1.5 {nice tests} {
  76.     nice 4
  77. } 0 [expr $niceBase+3+4]
  78.  
  79. if {[id user] != "root"} {
  80.  
  81.     Test nice-1.7 {nice tests} {
  82.         set errList {{not owner} {permission denied} {not privileged}
  83.                      {no permission match} {invalid argument}}
  84.         set stat [catch {nice -1} msg]
  85.         set msg [string tolower $msg]
  86.         if {[lsearch $errList $msg] < 0} {
  87.             set stat [list $stat $msg]
  88.         }
  89.         set stat
  90.     } 0 1
  91.  
  92.     puts "*************************************************************"
  93.     puts "You are not running as `root', certain nice tests will be"
  94.     puts "skipped"
  95.     puts "*************************************************************"
  96.     exit
  97. }
  98.  
  99. Test nice-1.8 {nice tests} {
  100.     nice -1
  101. } 0 [expr $niceBase+3+4-1]
  102.  
  103. Test nice-1.10 {nice tests} {
  104.     nice -9
  105. } 0 [expr $niceBase+3+4-1-9]
  106.  
  107. Test nice-1.11 {nice tests} {
  108.     nice -10
  109. } 0 [expr $niceBase+3+4-1-9-10]
  110.  
  111. Test nice-1.12 {nice tests} {
  112.     nice -1
  113. } 0 [expr $niceBase+3+4-1-9-10-1]
  114.  
  115. exit
  116.