Subject: | Re: Data-Diver-1.0101: Dive() does not do advertised scalar reference dereferencing |
Date: | Fri, 30 Oct 2015 12:04:54 +0000 |
To: | "bug-Data-Diver [...] rt.cpan.org" <bug-Data-Diver [...] rt.cpan.org> |
From: | Kevin Broadey <kevin.broadey [...] ptti.co.uk> |
To comply with the documentation the test for ref($key) should be done *before* the test for a number. Here’s a new patch (same code, different place):-
diff -u Diver.pm Diver.pm.1.01_02
--- Diver.pm 2005-09-03 07:57:22.000000000 +0100
+++ Diver.pm.1.01_02 2015-10-30 12:02:30.000000000 +0000
@@ -4,7 +4,7 @@
require Exporter;
use vars qw( $VERSION @EXPORT_OK );
BEGIN {
- $VERSION= 1.01_01;
+ $VERSION= 1.01_02;
@EXPORT_OK= qw( Dive DiveRef DiveVal DiveError DiveDie DiveClear );
*import= \&Exporter::import;
*isa= \&UNIVERSAL::isa;
@@ -80,6 +80,10 @@
} else {
$ref= [ $ref->( @$key ) ];
}
+ } elsif( ref($key)
+ && eval { exists $ref->{$$key} }
+ ) {
+ $ref= $ref->{$$key};
} elsif( $key =~ /^-?\d+$/
&& eval { my $x= $ref->[0]; 1 }
) {
On 29/10/2015, 20:42, "Kevin Broadey" <kevin.broadey@ptti.co.uk> wrote:
Show quoted text
>The POD says:
>
>For both Dive() and DiveRef(), each $key in @ListOfKeys can have the following values:
>
>[…snip…]
>a reference to a scalarThis means that you expect $ref to be a reference to a hash and you want to dereference it using $$key as the key.
>
>
>This is true for DiveRef (and therefore DiveVal) but it is NOT true for Dive itself. Looking at the code, the handling for ‘$$key’ around line 90 is flawed.
>
>Here’s a test case to show the bug:-
>
>-------------------------------------------------------------------------------
>
>#!/usr/bin/perl
>
>use strict;
>use warnings;
>
>use Data::Diver qw(Dive DiveVal DiveError);
>use Data::Dumper;
>
>my %Collection;
>
>my @keys = qw(Location WNHO110 I 20151018);
>my @keyrefs = \((@keys));
>
>sub value_or_dive_error
>{
> my $expr = shift;
>
> my $value = eval "[ $expr || DiveError() ]";
>
> print "$expr: @$value\n";
>}
>
>DiveVal(\%Collection, @keyrefs) = "Hello World!";
>
>value_or_dive_error 'Dive(\%Collection, @keyrefs)';
>value_or_dive_error 'Dive(\%Collection, \((@keys)) )';
>value_or_dive_error 'Dive(\%Collection, @keys)';
>value_or_dive_error 'DiveVal(\%Collection, @keyrefs)';
>
>print Data::Dumper->Dump([\%Collection], [qw(Collection)]);
>
>-------------------------------------------------------------------------------
>
>Here’s the output with the faulty code...
>
>
>./Data-Dumper-bug.pl
>Dive(\%Collection, @keyrefs): Key not present in hash HASH(0x7fb1c20173c8) REF(0x7fb1c20226e0)
>Dive(\%Collection, \((@keys)) ): Key not present in hash HASH(0x7fb1c20173c8) REF(0x7fb1c287a5c8)
>Dive(\%Collection, @keys): Hello World!
>DiveVal(\%Collection, @keyrefs): Hello World!
>$Collection = {
> 'Location' => {
> 'WNHO110' => {
> 'I' => {
> '20151018' => 'Hello World!'
> }
> }
> }
> };
>
>
>-------------------------------------------------------------------------------
>
>Here’s a patch to fix it - though you may want to revisit the ‘$$key’ stuff immediately after in the original code...
>
>
>
>diff -u Diver.pm.orig Diver.pm
>--- Diver.pm.orig 2005-09-03 07:57:22.000000000 +0100
>+++ Diver.pm 2015-10-29 20:40:24.000000000 +0000
>@@ -4,7 +4,7 @@
> require Exporter;
> use vars qw( $VERSION @EXPORT_OK );
> BEGIN {
>- $VERSION= 1.01_01;
>+ $VERSION= 1.01_02;
> @EXPORT_OK= qw( Dive DiveRef DiveVal DiveError DiveDie DiveClear );
> *import= \&Exporter::import;
> *isa= \&UNIVERSAL::isa;
>@@ -87,6 +87,10 @@
> if $key < -@$ref
> || $#$ref < $key;
> $ref= $ref->[$key];
>+ } elsif( ref($key)
>+ && eval { exists $ref->{$$key} }
>+ ) {
>+ $ref= $ref->{$$key};
> } elsif( eval { exists $ref->{$key} } ) {
> if( eval { my $x= $$key; 1 } ) {
> $ref= $ref->{$$key};
>
>
>-------------------------------------------------------------------------------
>
>and here’s the proof the fix works…
>
>
>./Data-Dumper-bug.pl
>Dive(\%Collection, @keyrefs): Hello World!
>Dive(\%Collection, \((@keys)) ): Hello World!
>Dive(\%Collection, @keys): Hello World!
>DiveVal(\%Collection, @keyrefs): Hello World!
>$Collection = {
> 'Location' => {
> 'WNHO110' => {
> 'I' => {
> '20151018' => 'Hello World!'
> }
> }
> }
> };
>
>-------------------------------------------------------------------------------
>
>All the best
>
>Kevin
>
>