[svn:parrot] r8972 - in branches/leo-ctx5: classes languages/tcl/classes languages/tcl/t

[leo]

Author: leo
Date: Tue Aug 16 04:10:03 2005
New Revision: 8972

Modified:
   branches/leo-ctx5/classes/key.pmc
   branches/leo-ctx5/languages/tcl/classes/tclarray.pmc
   branches/leo-ctx5/languages/tcl/t/cmd_join.t
Log:
merge -r8967:8971 from trunk

Modified: branches/leo-ctx5/classes/key.pmc
==============================================================================
--- branches/leo-ctx5/classes/key.pmc   (original)
+++ branches/leo-ctx5/classes/key.pmc   Tue Aug 16 04:10:03 2005
@@ -281,6 +281,7 @@ PMC_int_val(-1) means end of iteration.
     PMC* nextkey_keyed (PMC* agg, INTVAL what) {
         INTVAL n = VTABLE_elements(INTERP, agg);
         PMC *ret = SELF;
+        STRING *_hash;
 
         switch (what) {
             case ITERATE_FROM_START_KEYS:
@@ -303,9 +304,8 @@ PMC_int_val(-1) means end of iteration.
                  * KEY_integer_FLAG alone is an indexed hash lookup
                  * with an Integer KEY
                  */
-                if (agg->vtable->base_type == enum_class_PerlHash)
-                    PObj_get_FLAGS(ret) |= KEY_hash_iterator_FLAGS;
-                if (agg->vtable->base_type == enum_class_Hash)
+                 _hash = CONST_STRING(interpreter, "Hash");
+                if (VTABLE_isa(INTERP, agg, _hash))
                     PObj_get_FLAGS(ret) |= KEY_hash_iterator_FLAGS;
         init:
                 PMC_int_val(ret) = 0;

Modified: branches/leo-ctx5/languages/tcl/classes/tclarray.pmc
==============================================================================
--- branches/leo-ctx5/languages/tcl/classes/tclarray.pmc        (original)
+++ branches/leo-ctx5/languages/tcl/classes/tclarray.pmc        Tue Aug 16 
04:10:03 2005
@@ -28,7 +28,7 @@ This is the Array PMC for the Tcl implem
 
 #include "parrot/parrot.h"
 
-static INTVAL dynclass_TclInt;
+static INTVAL dynclass_TclString;
 
 /*
 
@@ -65,7 +65,7 @@ Initializes variables needed by the clas
 
     void class_init () {
         if (pass) {
-            dynclass_TclInt = Parrot_PMC_typenum(INTERP,"TclInt");
+            dynclass_TclString = Parrot_PMC_typenum(INTERP,"TclString");
         }
     }
 
@@ -83,10 +83,19 @@ XXX - Why is Hash's implementation insuf
 
 
     PMC* get_pmc_keyed (PMC* key) {
-        STRING* keystr = make_hash_key(INTERP, key);
-        HashBucket *b = hash_get_bucket(INTERP, (Hash*) PMC_struct_val(SELF),
-                                        keystr);
-        PMC* nextkey;
+        STRING *s;
+        PMC* nextkey, *result;
+        Hash *hash = PMC_struct_val(SELF);
+        HashBucket *b;
+        switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
+            case KEY_hash_iterator_FLAGS:
+                s = hash_get_idx(INTERP, hash, key);
+                result = pmc_new(INTERP, dynclass_TclString);
+                VTABLE_set_string_native(INTERP, result, s);
+                return result;
+        }
+        s = make_hash_key(INTERP, key);
+        b = hash_get_bucket(INTERP, hash, s);
         if (b == NULL) {
             return NULL;
         }

Modified: branches/leo-ctx5/languages/tcl/t/cmd_join.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/cmd_join.t        (original)
+++ branches/leo-ctx5/languages/tcl/t/cmd_join.t        Tue Aug 16 04:10:03 2005
@@ -3,7 +3,6 @@
 use strict;
 use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
 use Parrot::Test tests => 7;
-use vars qw($TODO);
 
 language_output_is("tcl",<<TCL,<<OUT,"bad join 1");
   puts [join]