home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / ITCL / _ITCL.TAR / usr / lib / itcl / tests / upvar.test < prev    next >
Encoding:
Text File  |  1994-03-21  |  3.8 KB  |  124 lines
  1. #
  2. # Tests for "upvar" across interpreter boundaries
  3. # ----------------------------------------------------------------------
  4. #   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
  5. #            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
  6. #
  7. #      RCS:  upvar.test,v 1.1.1.1 1994/03/21 22:09:52 mmc Exp
  8. # ----------------------------------------------------------------------
  9. #               Copyright (c) 1993  AT&T Bell Laboratories
  10. # ======================================================================
  11. # Permission to use, copy, modify, and distribute this software and its
  12. # documentation for any purpose and without fee is hereby granted,
  13. # provided that the above copyright notice appear in all copies and that
  14. # both that the copyright notice and warranty disclaimer appear in
  15. # supporting documentation, and that the names of AT&T Bell Laboratories
  16. # any of their entities not be used in advertising or publicity
  17. # pertaining to distribution of the software without specific, written
  18. # prior permission.
  19. #
  20. # AT&T disclaims all warranties with regard to this software, including
  21. # all implied warranties of merchantability and fitness.  In no event
  22. # shall AT&T be liable for any special, indirect or consequential
  23. # damages or any damages whatsoever resulting from loss of use, data or
  24. # profits, whether in an action of contract, negligence or other
  25. # tortuous action, arising out of or in connection with the use or
  26. # performance of this software.
  27. # ======================================================================
  28.  
  29. # ----------------------------------------------------------------------
  30. #  DEFINE SOME USEFUL ROUTINES
  31. # ----------------------------------------------------------------------
  32. proc upvarTest_show_var {var val} {
  33.     return "$var>>$val"
  34. }
  35.  
  36. proc upvarTest_upvar_in_procs {} {
  37.     set upvarTest_var_local "value in main interp"
  38.     foo do {
  39.         upvar upvarTest_var_local var
  40.         set var
  41.     }
  42. }
  43.  
  44. # ----------------------------------------------------------------------
  45. #  CREATE SOME OBJECTS
  46. # ----------------------------------------------------------------------
  47. Foo foo
  48. Baz baz
  49.  
  50. # ----------------------------------------------------------------------
  51. #  UPVAR TESTS
  52. # ----------------------------------------------------------------------
  53. test {"::" sends command to global interp but preserves
  54. local variables.  This ensures that when control
  55. shifts to the global scope for Extended Tcl commands,
  56. Expect commands, etc., local variables will be
  57. recognized.} {
  58.     foo do {
  59.         set localvar "special"
  60.         ::eval {upvarTest_show_var localvar $localvar}
  61.     }
  62. } {
  63.     $result == "Foo says 'localvar>>special'"
  64. }
  65.  
  66.  
  67. test {"upvar" can cross interp boundaries to access local variables} {
  68.     upvarTest_upvar_in_procs
  69. } {
  70.     $result == "Foo says 'value in main interp'"
  71. }
  72.  
  73. test {"upvar" can cross interp boundaries to access global variables} {
  74.     set upvarTest_var_global "value in main interp"
  75.     foo do {
  76.         upvar upvarTest_var_global var
  77.         set var
  78.     }
  79. } {
  80.     $result == "Foo says 'value in main interp'"
  81. }
  82.  
  83. test {"upvar" can handle multiple call frames on the stack} {
  84.     set upvarTest_var_global "new value"
  85.     foo do {
  86.         foo do {
  87.             upvar #0 upvarTest_var_global var
  88.             set var
  89.         }
  90.     }
  91. } {
  92.     $result == "Foo says 'Foo says 'new value''"
  93. }
  94.  
  95. test {"upvar" can cross class interp boundaries} {
  96.     baz do {
  97.         set localvar "value in Baz"
  98.         foo do {
  99.             upvar localvar var
  100.             set var
  101.         }
  102.     }
  103. } {
  104.     $result == "Baz says 'Foo says 'value in Baz''"
  105. }
  106.  
  107. test {"upvar" can cross class interp boundaries back to main interp} {
  108.     set upvarTest_var_global "global value"
  109.     baz do {
  110.         foo do {
  111.             upvar 2 upvarTest_var_global var
  112.             set var
  113.         }
  114.     }
  115. } {
  116.     $result == "Baz says 'Foo says 'global value''"
  117. }
  118.  
  119. # ----------------------------------------------------------------------
  120. #  CLEAN UP
  121. # ----------------------------------------------------------------------
  122. foo delete
  123. baz delete
  124.