languages/tcl/t/cmd_proc.t

   1 #!perl
   2
   3 # Copyright (C) 2004-2007, 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 plan 19
  14
  15 eval_is {
  16  set a [proc me {} {
  17   return 2
  18  }]
  19  list [me] [set a]
  20 } {2 {}} {return value}
  21
  22 eval_is {
  23  proc foo {} {
  24    append x {foo bar}
  25  }
  26  foo
  27 } {foo bar} {return value from user-defined command}
  28
  29 eval_is {
  30  proc me {} {
  31   return 2
  32  }
  33  me
  34 } 2 {no args}
  35
  36 eval_is {
  37  proc me {a} {
  38   return $a
  39  }
  40  me 2
  41 } 2 {one arg}
  42
  43 eval_is {
  44  proc me {a b} {
  45   list $a $b
  46  }
  47  me 2 3
  48 } {2 3} {two args}
  49
  50 eval_is {
  51  proc me {a b} {
  52   list $a $b
  53  }
  54  me 2 3 4
  55 } {wrong # args: should be "me a b"} {too many args}
  56
  57 eval_is {
  58  proc me {a b} {
  59   list $a $b
  60  }
  61  me 2
  62 } {wrong # args: should be "me a b"} {too few args}
  63
  64 eval_is {
  65   proc test {} {}
  66   test foo bar
  67 } {wrong # args: should be "test"} {bad args - expected none}
  68
  69 eval_is {
  70  proc me {a b args} {
  71   list $a $b
  72  }
  73  me 2
  74 } {wrong # args: should be "me a b ..."} {bad varargs}
  75
  76 eval_is {
  77  proc me {a args} {
  78   list $a $args
  79  }
  80  me 2 3 4 5 6
  81 } {2 {3 4 5 6}} {vararg}
  82
  83 eval_is {
  84  proc me {a args} {
  85   list $a $args
  86  }
  87  me 2
  88 } {2 {}} {vararg empty}
  89
  90 eval_is {
  91   rename incr incr_old
  92   proc incr {varName} {return $varName}
  93   proc test {} { incr a }
  94   set a [test]
  95   rename incr {}
  96   rename incr_old incr
  97   set a
  98 } {a} {using a renamed builtin}
  99
 100 eval_is {
 101   proc a::b {} {puts a::b}
 102   a::b
 103 } {can't create procedure "a::b": unknown namespace} {unknown namespace}
 104
 105 eval_is {
 106  proc me {{a 2}} {
 107   return $a
 108  }
 109  list [me] [me 7]
 110 } {2 7} {default args}
 111
 112 eval_is {
 113  proc me {{a 2 3}} {
 114   return $a
 115  }
 116 } {too many fields in argument specifier "a 2 3"} {bad default arg spec}
 117
 118 eval_is {
 119   proc test {{a 2} b} {list $a $b}
 120   test 3
 121 } {wrong # args: should be "test ?a? b"} {default arg with too few args}
 122
 123 eval_is {
 124   proc test {{a 2}} {return $a}
 125   test 3 4
 126 } {wrong # args: should be "test ?a?"} {default too many args}
 127
 128 eval_is {
 129   proc test {} {}
 130   set a 4
 131   catch {test foo}
 132   set a
 133 } 4 {reset call_level on bad args}
 134
 135 eval_is {
 136  proc nothing {} {
 137     # empty proc
 138  }
 139 } {} {empty procs are ok}