[svn:parrot] r8891 - trunk/languages/tcl/t

[coke]

Author: coke
Date: Tue Aug  9 10:26:24 2005
New Revision: 8891

Modified:
   trunk/languages/tcl/t/cmd_array.t
Log:
tcl: add tests for [array get]



Modified: trunk/languages/tcl/t/cmd_array.t
==============================================================================
--- trunk/languages/tcl/t/cmd_array.t   (original)
+++ trunk/languages/tcl/t/cmd_array.t   Tue Aug  9 10:26:24 2005
@@ -2,7 +2,7 @@
 
 use strict;
 use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 18;
+use Parrot::Test tests => 24;
 use Test::More;
 use vars qw($TODO);
 
@@ -136,3 +136,46 @@ language_output_is("tcl",<<'TCL',<<'OUT'
 TCL
 
 OUT
+
+TODO: {
+ local $TODO = "unimplemented";
+
+language_output_is("tcl",<<'TCL',<<'OUT',"array get");
+  array set a [list a b]
+  puts [array get a]
+TCL
+a b
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"array get, with pattern");
+  array set a [list a b c d]
+  puts [array get a a]
+TCL
+a b
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"array get, with pattern");
+  array set a [list apple 1 orange 2 aardvark 3]
+  puts [array get a a*]
+TCL
+apple 1 aardvark 3
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"array get, bad array");
+  puts [array get a]
+TCL
+
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"array get, bad array with pattern");
+  puts [array get a a]
+TCL
+
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"array get, too many args");
+  array get a b c
+TCL
+wrong # args: should be "array get arrayName ?pattern?"
+OUT
+}