[svn:parrot] r29910 - in trunk/languages/tcl: runtime runtime/builtin src/pmc t

[coke@xxxxxxxxxxxx]

Author: coke
Date: Thu Jul 31 11:42:33 2008
New Revision: 29910

Modified:
   trunk/languages/tcl/runtime/builtin/array.pir
   trunk/languages/tcl/runtime/builtin/unset.pir
   trunk/languages/tcl/runtime/string_to_list.pir
   trunk/languages/tcl/runtime/variables.pir
   trunk/languages/tcl/src/pmc/tclarray.pmc
   trunk/languages/tcl/t/cmd_array.t

Log:
[tcl] -TclArray uses a hash, but isn't really a parrot-style hash (no nested 
keys), so create a new 'does' type and key off that instead of specifically 
checking the type, or seeing if we 'does hash'.
- switch a string check over to isa from typeof.
- Fix a typo 



Modified: trunk/languages/tcl/runtime/builtin/array.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/array.pir       (original)
+++ trunk/languages/tcl/runtime/builtin/array.pir       Thu Jul 31 11:42:33 2008
@@ -46,8 +46,8 @@
 
   if_null the_array, array_no
 
-  $I99 = does the_array, 'hash'
-  if $I99==0 goto array_no
+  $I99 = does the_array, 'associative_array'
+  unless $I99 goto array_no
 
   is_array = 1
   goto scommand

Modified: trunk/languages/tcl/runtime/builtin/unset.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/unset.pir       (original)
+++ trunk/languages/tcl/runtime/builtin/unset.pir       Thu Jul 31 11:42:33 2008
@@ -55,7 +55,7 @@
 
   var = find_var(array_name)
   if null var goto no_such_var
-  $I0 = isa var, 'TclArray'
+  $I0 = does var, 'associative_array'
   unless $I0 goto variable_isnt_array
 
   $I0 = exists var[key]

Modified: trunk/languages/tcl/runtime/string_to_list.pir
==============================================================================
--- trunk/languages/tcl/runtime/string_to_list.pir      (original)
+++ trunk/languages/tcl/runtime/string_to_list.pir      Thu Jul 31 11:42:33 2008
@@ -22,9 +22,8 @@
   inc pos
   $P2 = list[pos]
   inc pos
-  $S0 = typeof $P2
-  if $S0 == 'TclConst'  goto is_string
-  if $S0 == 'TclString'  goto is_string
+  $I0 = isa $P2, 'String'
+  if $I0 goto is_string
 is_list:
   $P2 = listToDict($P2)
   result[$S1] = $P2

Modified: trunk/languages/tcl/runtime/variables.pir
==============================================================================
--- trunk/languages/tcl/runtime/variables.pir   (original)
+++ trunk/languages/tcl/runtime/variables.pir   Thu Jul 31 11:42:33 2008
@@ -42,7 +42,7 @@
   variable = findVar(var)
   if null variable goto no_such_variable
 
-  $I0 = does variable, 'hash'
+  $I0 = does variable, 'associative_array'
   unless $I0 goto cant_read_not_array
 
   variable = variable[key]
@@ -67,8 +67,8 @@
   variable = findVar(name)
   if null variable goto no_such_variable
 
-  $S0 = typeof variable
-  if $S0 == 'TclArray' goto cant_read_array
+  $I0 = does variable, 'associative_array'
+  if $I0 goto cant_read_array
   .return(variable)
 
 cant_read_array:
@@ -130,7 +130,7 @@
   variable = storeVar(var, variable, 'depth' => depth)
 
 check_is_hash:
-  $I0 = does variable, 'hash'
+  $I0 = does variable, 'associative_array'
   unless $I0 goto cant_read_not_array
 
   $P0 = variable[key]
@@ -209,7 +209,7 @@
   array = findVar(var)
   if null array goto create_array
 
-  $I0 = does array, 'hash'
+  $I0 = does array, 'associative_array'
   unless $I0 goto cant_set_not_array
   goto set_array
 
@@ -238,8 +238,8 @@
 scalar:
   $P0 = findVar(name)
   if null $P0 goto create_scalar
-  $S0 = typeof $P0
-  if $S0 == 'TclArray' goto cant_set_array
+  $I0 = does $P0, 'associative_array'
+  if $I0 goto cant_set_array
 
 create_scalar:
   storeVar(name, value)

Modified: trunk/languages/tcl/src/pmc/tclarray.pmc
==============================================================================
--- trunk/languages/tcl/src/pmc/tclarray.pmc    (original)
+++ trunk/languages/tcl/src/pmc/tclarray.pmc    Thu Jul 31 11:42:33 2008
@@ -20,7 +20,7 @@
     need_ext
     dynpmc
     extends Hash
-    provides    hash
+    provides associative_array
     group   tcl_group
     hll     Tcl
     maps    Hash

Modified: trunk/languages/tcl/t/cmd_array.t
==============================================================================
--- trunk/languages/tcl/t/cmd_array.t   (original)
+++ trunk/languages/tcl/t/cmd_array.t   Thu Jul 31 11:42:33 2008
@@ -22,7 +22,7 @@
 
 eval_is {array bork foo}\
   {bad option "bork": must be anymore, donesearch, exists, get, names, 
nextelement, set, size, startsearch, statistics, or unset}\
-  {array, bad subcommand, bad arary}
+  {array, bad subcommand, bad array}
 
 eval_is {
  set b(c) 2