diff options
| author | Anno Siegel <anno4000@lublin.zrz.tu-berlin.de> | 2007-04-21 04:11:00 +0200 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-04-21 08:55:16 +0000 |
| commit | d020b00bb8acda6af3dd46a1ca1af4bb77f958a6 (patch) | |
| tree | a6c01b2c9eec0db491521662c17184f7655434f6 /ext | |
| parent | 33e12d9d267d9578365b1a5116be5449323ba82f (diff) | |
| download | perl-d020b00bb8acda6af3dd46a1ca1af4bb77f958a6.tar.gz | |
Bug in Hash::Util::FieldHash
Message-Id: <DFEC2420-9301-40EC-A986-80D0290B2C8F@mailbox.tu-berlin.de>
p4raw-id: //depot/perl@31001
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/Hash/Util/FieldHash/Changes | 5 | ||||
| -rw-r--r-- | ext/Hash/Util/FieldHash/FieldHash.xs | 5 | ||||
| -rw-r--r-- | ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm | 2 | ||||
| -rw-r--r-- | ext/Hash/Util/FieldHash/t/02_function.t | 17 |
4 files changed, 28 insertions, 1 deletions
diff --git a/ext/Hash/Util/FieldHash/Changes b/ext/Hash/Util/FieldHash/Changes index 841bce84d6..5ffc28fa47 100644 --- a/ext/Hash/Util/FieldHash/Changes +++ b/ext/Hash/Util/FieldHash/Changes @@ -5,3 +5,8 @@ Revision history for Perl extension Hash::Util::FieldHash. -A -g --skip-ppport -nHash::Util::FieldHash Fri Jun 23 22:31:59 CEST 2006 - accepted as v5.9.4 DEVEL28420 + + +0.02 Fri Apr 20 22:22:57 CEST 2007 + - Bugfix: string keys are now checked whether they represent + an object, so %fieldhash_clone = %fieldhash_orig works. diff --git a/ext/Hash/Util/FieldHash/FieldHash.xs b/ext/Hash/Util/FieldHash/FieldHash.xs index 6bc07cc37b..a749fc763c 100644 --- a/ext/Hash/Util/FieldHash/FieldHash.xs +++ b/ext/Hash/Util/FieldHash/FieldHash.xs @@ -193,6 +193,11 @@ I32 HUF_watch_key(pTHX_ IV action, SV* field) { SV* keysv; if (mg) { keysv = mg->mg_obj; + if (keysv && !SvROK(keysv)) { /* is string an object-id? */ + SV* obj = HUF_ask_trigger(keysv); + if (obj) + keysv = obj; /* use the object instead, so registry happens */ + } if (keysv && SvROK(keysv)) { SV* ob_id = HUF_obj_id(keysv); mg->mg_obj = ob_id; /* key replacement */ diff --git a/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm b/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm index 824873aad1..be1ab9a2be 100644 --- a/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm +++ b/ext/Hash/Util/FieldHash/lib/Hash/Util/FieldHash.pm @@ -15,7 +15,7 @@ our %EXPORT_TAGS = ( ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); -our $VERSION = '0.01_01'; +our $VERSION = '0.02'; { require XSLoader; diff --git a/ext/Hash/Util/FieldHash/t/02_function.t b/ext/Hash/Util/FieldHash/t/02_function.t index 7796ff8944..745ff3f8c1 100644 --- a/ext/Hash/Util/FieldHash/t/02_function.t +++ b/ext/Hash/Util/FieldHash/t/02_function.t @@ -190,6 +190,23 @@ BEGIN { $n_tests += 6 } is( keys %$ob_reg, @obs, "all obs unregistered"); } + +# direct hash assignment +BEGIN { $n_tests += 4 } +{ + fieldhashes \ my( %f, %g, %h); + my $size = 6; + my @obs = map [], 1 .. $size; + @f{ @obs} = ( 1) x $size; + $g{ $_} = $f{ $_} for keys %f; # single assignment + %h = %f; # wholesale assignment + @obs = (); + is keys %$ob_reg, 0, "all keys collected"; + is keys %f, 0, "orig garbage-collected"; + is keys %g, 0, "single-copy garbage-dollected"; + is keys %h, 0, "wholesale-copy garbage-dollected"; +} + { BEGIN { $n_tests += 1 } |