home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tcl7.0b1 / tests / case.test < prev    next >
Encoding:
Text File  |  1993-06-17  |  5.1 KB  |  127 lines
  1. # Commands covered:  case
  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/case.test,v 1.11 93/06/17 11:22:41 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30. # Commands covered:  case
  31. #
  32. # This file contains a collection of tests for one or more of the Tcl
  33. # built-in commands.  Sourcing this file into Tcl runs the tests and
  34. # generates output for errors.  No output means no errors were found.
  35. #
  36. # Copyright (c) 1991-1993 The Regents of the University of California.
  37. # All rights reserved.
  38. #
  39. # Permission is hereby granted, without written agreement and without
  40. # license or royalty fees, to use, copy, modify, and distribute this
  41. # software and its documentation for any purpose, provided that the
  42. # above copyright notice and the following two paragraphs appear in
  43. # all copies of this software.
  44. #
  45. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  46. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  47. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  48. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  49. #
  50. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  51. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  52. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  53. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  54. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  55. #
  56. # $Header: /user6/ouster/tcl/tests/RCS/case.test,v 1.11 93/06/17 11:22:41 ouster Exp $ (Berkeley)
  57.  
  58. if {[string compare test [info procs test]] == 1} then {source defs}
  59.  
  60. test case-1.1 {simple pattern} {
  61.     case a in a {format 1} b {format 2} c {format 3} default {format 4}
  62. } 1
  63. test case-1.2 {simple pattern} {
  64.     case b a {format 1} b {format 2} c {format 3} default {format 4}
  65. } 2
  66. test case-1.3 {simple pattern} {
  67.     case x in a {format 1} b {format 2} c {format 3} default {format 4}
  68. } 4
  69. test case-1.4 {simple pattern} {
  70.     case x a {format 1} b {format 2} c {format 3}
  71. } {}
  72. test case-1.5 {simple pattern matches many times} {
  73.     case b a {format 1} b {format 2} b {format 3} b {format 4}
  74. } 2
  75. test case-1.6 {fancier pattern} {
  76.     case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
  77. } 3
  78. test case-1.7 {list of patterns} {
  79.     case abc in {a b c} {format 1} {def abc ghi} {format 2}
  80. } 2
  81.  
  82. test case-2.1 {error in executed command} {
  83.     list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
  84.         $msg $errorInfo
  85. } {1 {Just a test} {Just a test
  86.     while executing
  87. "error "Just a test""
  88.     ("a" arm line 1)
  89.     invoked from within
  90. "case a in a {error "Just a test"} default {format 1}"}}
  91. test case-2.2 {error: not enough args} {
  92.     list [catch {case} msg] $msg
  93. } {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
  94. test case-2.3 {error: pattern with no body} {
  95.     list [catch {case a b} msg] $msg
  96. } {1 {extra case pattern with no body}}
  97. test case-2.4 {error: pattern with no body} {
  98.     list [catch {case a in b {format 1} c} msg] $msg
  99. } {1 {extra case pattern with no body}}
  100. test case-2.5 {error in default command} {
  101.     list [catch {case foo in a {error case1} default {error case2} \
  102.         b {error case 3}} msg] $msg $errorInfo
  103. } {1 case2 {case2
  104.     while executing
  105. "error case2"
  106.     ("default" arm line 1)
  107.     invoked from within
  108. "case foo in a {error case1} default {error case2}  b {error case 3}"}}
  109.  
  110. test case-3.1 {single-argument form for pattern/command pairs} {
  111.     case b in {
  112.     a {format 1}
  113.     b {format 2}
  114.     default {format 6}
  115.     }
  116. } {2}
  117. test case-3.2 {single-argument form for pattern/command pairs} {
  118.     case b {
  119.     a {format 1}
  120.     b {format 2}
  121.     default {format 6}
  122.     }
  123. } {2}
  124. test case-3.3 {single-argument form for pattern/command pairs} {
  125.     list [catch {case z in {a 2 b}} msg] $msg
  126. } {1 {extra case pattern with no body}}
  127.