languages/tcl/t/cmd_apply.t

   1 #!perl
   2
   3 # Copyright (C) 2006-2008, The Perl Foundation.
   4 # $Id$
   5
   6 # the following lines re-execute this as a tcl script
   7 # the \ at the end of these lines makes them a comment in tcl \
   8 use lib qw(languages/tcl/lib tcl/lib lib ../lib ../../lib); # \
   9 use Tcl::Test; #\
  10 __DATA__
  11
  12 source lib/test_more.tcl
  13
  14 plan 8
  15
  16 set TODO {TODO {not implemented yet}}
  17
  18 eval_is {apply foo} \
  19   {can't interpret "foo" as a lambda expression} \
  20   {bad lambda expression}
  21
  22 eval_is {apply {foo bar baz bit}} \
  23   {can't interpret "foo bar baz bit" as a lambda expression} \
  24   {bad lamdba expression}
  25
  26 eval_is {apply {foo bar baz}} \
  27   {namespace "::baz" not found} \
  28   {namespace doesn't exist} \
  29   $TODO
  30
  31 eval_is {apply} \
  32   {wrong # args: should be "apply lambdaExpr ?arg1 arg2 ...?"} \
  33   {too few args}
  34
  35 eval_is {apply {{foo {bar 2} {baz 3}}  bar}} \
  36   {wrong # args: should be "apply {{foo {bar 2} {baz 3}}  bar} foo ?bar? ?baz?"} \
  37   {too few args} \
  38   $TODO
  39
  40 eval_is {apply {{}   bar} foo} \
  41   {wrong # args: should be "apply {{}   bar}"} \
  42   {too many args} \
  43   $TODO
  44
  45 eval_is {apply {{n} {expr {$n*$n}}} {5}} 25 \
  46   {squaring function} \
  47   $TODO
  48
  49 eval_is {
  50   unset -nocomplain x func
  51   set x 4
  52   set func {
  53     upvar 1 $var n
  54     set n [expr {$n + 1}]
  55   }
  56   apply [list {var {i 1}} $func] x
  57   set x
  58 } 5 {incr} \
  59   $TODO