home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcl2-73c.zip / tcl7.3 / tests / env.test < prev    next >
Text File  |  1993-10-14  |  4KB  |  123 lines
  1. # Commands covered:  none (tests environment variable implementation)
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/env.test,v 1.7 93/10/14 14:59:14 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. # If there is no "printenv" program on this system, then it's just too
  32. # much trouble to run this test (can't necessarily run csh to get the
  33. # environment:  on some systems it barfs if there isn't a minimum set
  34. # predefined environment variables.  Also, printenv returns a non-zero
  35. # status on some systems, so read the environment using a procedure
  36. # that catches errors.
  37.  
  38. set printenv {}
  39. if [info exists env(PATH)] {
  40.     set dirs [split $env(PATH) :]
  41. } else {
  42.     set dirs {/bin /usr/bin /usr/ucb /usr/local /usr/public /usr/etc}
  43. }
  44. foreach i $dirs {
  45.     if [file executable $i/printenv] {
  46.     # The following hack is needed because of weirdness with
  47.     # environment variables in symbolic lines on Apollos (?!#?).
  48.     if ![catch {exec sh -c "cd $i; pwd"} x] {
  49.         set printenv $x/printenv
  50.     } else {
  51.         set printenv $i/printenv
  52.     }
  53.     break
  54.     }
  55. }
  56. if {$printenv == ""} {
  57.     puts stdout "Skipping env tests:  need \"printenv\" to read environment."
  58.     return ""
  59. }
  60. proc getenv {} {
  61.     global printenv
  62.     catch {exec $printenv} out
  63.     if {$out == "child process exited abnormally"} {
  64.     set out {}
  65.     }
  66.     return $out
  67. }
  68.  
  69. # Save the current environment variables at the start of the test.
  70.  
  71. foreach name [array names env] {
  72.     set env2($name) $env($name)
  73.     unset env($name)
  74. }
  75.  
  76. test env-1.1 {adding environment variables} {
  77.     getenv
  78. } {}
  79.  
  80. set env(NAME1) "test string"
  81. test env-1.2 {adding environment variables} {
  82.     getenv
  83. } {NAME1=test string}
  84.  
  85. set env(NAME2) "more"
  86. test env-1.3 {adding environment variables} {
  87.     getenv
  88. } {NAME1=test string
  89. NAME2=more}
  90.  
  91. set env(XYZZY) "garbage"
  92. test env-1.4 {adding environment variables} {
  93.     getenv
  94. } {NAME1=test string
  95. NAME2=more
  96. XYZZY=garbage}
  97.  
  98. set env(NAME2) "new value"
  99. test env-2.1 {changing environment variables} {
  100.     getenv
  101. } {NAME1=test string
  102. NAME2=new value
  103. XYZZY=garbage}
  104.  
  105. unset env(NAME2)
  106. test env-3.1 {unsetting environment variables} {
  107.     getenv
  108. } {NAME1=test string
  109. XYZZY=garbage}
  110. unset env(NAME1)
  111. test env-3.2 {unsetting environment variables} {
  112.     getenv
  113. } {XYZZY=garbage}
  114.  
  115. # Restore the environment variables at the end of the test.
  116.  
  117. foreach name [array names env] {
  118.     unset env($name)
  119. }
  120. foreach name [array names env2] {
  121.     set env($name) $env2($name)
  122. }
  123.