[svn:parrot] r8894 - in trunk/languages/tcl: lib/commands t

[mdiep]

Author: mdiep
Date: Tue Aug  9 10:33:23 2005
New Revision: 8894

Modified:
   trunk/languages/tcl/lib/commands/array.pir
   trunk/languages/tcl/t/cmd_array.t
Log:
tcl: Add 'variable not array' error for [array set]

Modified: trunk/languages/tcl/lib/commands/array.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/array.pir  (original)
+++ trunk/languages/tcl/lib/commands/array.pir  Tue Aug  9 10:33:23 2005
@@ -164,9 +164,11 @@ pre_loop:
   .local int loop
   loop = 0
   .local string key
-  .local string val
+  .local pmc    val
+  
+  .local pmc set
+  set = find_global  "_Tcl", "__set"
 
-  if is_array == 0 goto new_array
   isnull the_array, new_array
   goto set_loop
 
@@ -178,14 +180,16 @@ set_loop:
   inc loop
   val = elems[loop]
   inc loop
-  the_array[key] = val
-  if loop < count goto set_loop
-
-  # set the actual variable
-  .local pmc set
-  set = find_global  "_Tcl", "__set"
-  (return_type, retval) = set(array_name, the_array)
+  
+  # = makes an alias :-(
+  assign $S0, array_name
+  $S0 .= "("
+  $S0 .= key
+  $S0 .= ")"
+  (return_type, retval) = set($S0, val)
   if return_type == TCL_ERROR goto done
+  
+  if loop < count goto set_loop
 
   retval = new String
   retval = ""

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:33:23 2005
@@ -2,7 +2,7 @@
 
 use strict;
 use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 25;
 use Test::More;
 use vars qw($TODO);
 
@@ -137,6 +137,13 @@ TCL
 
 OUT
 
+language_output_is("tcl",<<'TCL',<<'OUT',"array set not array");
+  set a 44
+  array set a {1 2 3 4}
+TCL
+can't set "a(1)": variable isn't array
+OUT
+
 TODO: {
  local $TODO = "unimplemented";