develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35896 - in trunk: src t/pmc

From:
infinoid
Date:
January 22, 2009 13:37
Subject:
[svn:parrot] r35896 - in trunk: src t/pmc
Message ID:
20090122213746.15F01CB9AE@x12.develooper.com
Author: infinoid
Date: Thu Jan 22 13:37:44 2009
New Revision: 35896

Modified:
   trunk/src/hash.c
   trunk/t/pmc/hash.t

Log:
[hash] Don't clone null hash keys.  This fixes TT #211.
Also add the test case from TT #211 to t/pmc/hash.t.

Modified: trunk/src/hash.c
==============================================================================
--- trunk/src/hash.c	(original)
+++ trunk/src/hash.c	Thu Jan 22 13:37:44 2009
@@ -1390,7 +1390,8 @@
             Parrot_ex_throw_from_c_args(interp, NULL, -1,
                 "hash corruption: type = %d\n", hash->entry_type);
         };
-        parrot_hash_put(interp, dest, key, valtmp);
+        if(key)
+            parrot_hash_put(interp, dest, key, valtmp);
     }
 }
 

Modified: trunk/t/pmc/hash.t
==============================================================================
--- trunk/t/pmc/hash.t	(original)
+++ trunk/t/pmc/hash.t	Thu Jan 22 13:37:44 2009
@@ -22,7 +22,7 @@
     .include 'test_more.pir'
     .include 'except_types.pasm'
 
-    plan(145)
+    plan(146)
 
     initial_hash_tests()
     more_than_one_hash()
@@ -43,6 +43,7 @@
     getting_values_from_undefined_keys()
     setting_and_getting_non_scalar_pmcs()
     testing_clone()
+    clone_doesnt_crash_on_deleted_keys()
     clone_preserves_order()
     freeze_thaw_preserves_order()
     compound_keys()
@@ -586,6 +587,19 @@
 #     print "ok 6\n"
 .end
 
+.sub clone_doesnt_crash_on_deleted_keys
+    .local pmc hash1, hash2
+    .local string key1, key2
+    hash1 = new 'Hash'
+    key1 = 'foo'
+    key2 = 'bar'
+    hash1[key1] = 1
+    hash1[key2] = 2
+    delete hash1[key1]
+    hash2 = clone hash1
+    ok( 1, "clone doesn't crash on deleted keys" )
+.end
+
 # TT #116
 # This test failure depends on the value if the hash seed, which is randomized.
 # To try to ensure that the test fails reliably if there's a regression, it's



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About