tests/apply.test

   1 # Commands covered:  apply
   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 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
   9 # Copyright (c) 1998-1999 by Scriptics Corporation.
  10 # Copyright (c) 2005-2006 Miguel Sofer
  11 #
  12 # See the file "license.terms" for information on usage and redistribution
  13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14
  15 source [file dirname [info script]]/testing.tcl
  16
  17 needs cmd apply
  18
  19 \f
  20 # Tests for wrong number of arguments
  21
  22 test apply-1.1 {too few arguments} -returnCodes error -body {
  23     apply
  24 } -result {wrong # args: should be "apply lambdaExpr ?arg ...?"}
  25
  26 # Tests for malformed lambda
  27
  28 test apply-2.0 {malformed lambda} -returnCodes error -body {
  29     set lambda a
  30     apply $lambda
  31 } -result {can't interpret "a" as a lambda expression}
  32 test apply-2.1 {malformed lambda} -returnCodes error -body {
  33     set lambda [list a b c d]
  34     apply $lambda
  35 } -result {can't interpret "a b c d" as a lambda expression}
  36 test apply-2.2 {malformed lambda} -body {
  37     set lambda [list {{}} boo]
  38     apply $lambda
  39 } -returnCodes error -match glob -result {*argument with no name}
  40 test apply-2.3 {malformed lambda} {
  41     set lambda [list {{a b c}} boo]
  42     list [catch {apply $lambda} msg] $msg
  43 } {1 {too many fields in argument specifier "a b c"}}
  44
  45 # Note that Jim allow both of these
  46 test apply-2.4 {malformed lambda} tcl {
  47     set lambda [list a(1) {return $a(1)}]
  48     list [catch {apply $lambda x} msg] $msg
  49 } {1 {formal parameter "a(1)" is an array element}}
  50 test apply-2.5 {malformed lambda} tcl {
  51     set lambda [list a::b {return $a::b}]
  52     list [catch {apply $lambda x} msg] $msg
  53 } {1 {formal parameter "a::b" is not a simple name}}
  54
  55 # Tests for runtime errors in the lambda expression
  56
  57 test apply-4.1 {error in arguments to lambda expression} -body {
  58     set lambda [list x {set x 1}]
  59     apply $lambda
  60 } -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
  61 test apply-4.2 {error in arguments to lambda expression} -body {
  62     set lambda [list x {set x 1}]
  63     apply $lambda a b
  64 } -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
  65
  66 test apply-5.1 {runtime error in lambda expression} {
  67     set lambda [list {} {error foo}]
  68     list [catch {apply $lambda} msg] $msg
  69 } {1 foo}
  70
  71 # Tests for correct execution; as the implementation is the same as that for
  72 # procs, the general functionality is mostly tested elsewhere
  73
  74 test apply-6.1 {info level} {
  75     set lev [info level]
  76     set lambda [list {} {info level}]
  77     expr {[apply $lambda] - $lev}
  78 } 1
  79 test apply-6.2 {info level} tcl {
  80     set lambda [list {} {info level 0}]
  81     apply $lambda
  82 } {apply {{} {info level 0}}}
  83 test apply-6.3 {info level} tcl {
  84     set lambda [list args {info level 0}]
  85     apply $lambda x y
  86 } {apply {args {info level 0}} x y}
  87
  88 # Tests for correct argument treatment
  89
  90 set applyBody {
  91     set res {}
  92     foreach v [lsort [info locals]] {
  93         if {$v eq "res"} continue
  94         lappend res [list $v [set $v]]
  95     }
  96     set res
  97 }
  98
  99 test apply-8.1 {args treatment} {
 100     apply [list args $applyBody] 1 2 3
 101 } {{args {1 2 3}}}
 102 test apply-8.2 {args treatment} {
 103     apply [list {x args} $applyBody] 1 2
 104 } {{args 2} {x 1}}
 105 test apply-8.3 {args treatment} {
 106     apply [list {x args} $applyBody] 1 2 3
 107 } {{args {2 3}} {x 1}}
 108 test apply-8.4 {default values} {
 109     apply [list {{x 1} {y 2}} $applyBody]
 110 } {{x 1} {y 2}}
 111 test apply-8.5 {default values} {
 112     apply [list {{x 1} {y 2}} $applyBody] 3 4
 113 } {{x 3} {y 4}}
 114 test apply-8.6 {default values} {
 115     apply [list {{x 1} {y 2}} $applyBody] 3
 116 } {{x 3} {y 2}}
 117 test apply-8.7 {default values} {
 118     apply [list {x {y 2}} $applyBody] 1
 119 } {{x 1} {y 2}}
 120 test apply-8.8 {default values} {
 121     apply [list {x {y 2}} $applyBody] 1 3
 122 } {{x 1} {y 3}}
 123 test apply-8.9 {default values} {
 124     apply [list {x {y 2} args} $applyBody] 1
 125 } {{args {}} {x 1} {y 2}}
 126 test apply-8.10 {default values} {
 127     apply [list {x {y 2} args} $applyBody] 1 3
 128 } {{args {}} {x 1} {y 3}}
 129
 130 test apply-9.1 {tailcall within apply} {
 131     proc p {y frame} {
 132         list [expr {$y * 2}] [expr {$frame - [info frame]}]
 133     }
 134     apply {{x} {
 135         tailcall p $x [info frame]
 136         notreached
 137     }} {4}
 138 } {8 0}
 139 test apply-9.2 {return from apply} {
 140     apply {{x} {
 141         return [expr {$x + 1}]
 142     }} {4}
 143 } {5}
 144
 145
 146 rename p {}
 147
 148 ::tcltest::cleanupTests
 149 return
 150
 151 # Local Variables:
 152 # mode: tcl
 153 # fill-column: 78
 154 # End: