Skip Menu |

This queue is for tickets about the Params-Util CPAN distribution.

Report information
The Basics
Id: 75561
Status: open
Priority: 0/
Queue: Params-Util
People
Owner: Nobody in particular
Requestors: AUBERTG [...] cpan.org
Cc:
AdminCc:
Bug Information
Severity: Important
Broken in: 1.06
Fixed in: (no value)

History Show all quoted text
  Mon Mar 05 18:23:34 2012 AUBERTG [...] cpan.org - Ticket created
Subject: _ARRAY() incorrect result on blessed arrays in non-PP mode
In pure perl mode, _ARRAY() returns the expected result on a blessed array: guillaume@avalon:~$ export PERL_PARAMS_UTIL_PP=1; perl -le 'use Data::Dumper; use Params::Util qw( :ALL ); print Dumper( _ARRAY( bless( [1 ,2, 3 ], "TEST" ) ) )'; $VAR1 = undef; However, in the default non-PP mode, this blessed array incorrectly passes the checks (the POD clearly specifies "to test for a raw and unblessed ARRAY reference"): guillaume@avalon:~$ export PERL_PARAMS_UTIL_PP=0; perl -le 'use Data::Dumper; use Params::Util qw( :ALL ); print Dumper( _ARRAY( bless( [1 ,2, 3 ], "TEST" ) ) )'; $VAR1 = bless( [ 1, 2, 3 ], 'TEST' ); For reference, I'm using 1.06: guillaume@avalon:~$ perl -le 'use Params::Util; print $Params::Util::VERSION;' 1.06 Thank you!
  Thu May 29 05:53:24 2014 paul [...] liekut.de - Correspondence added
From: paul [...] liekut.de
This issue still exists in Params::Util 1.07. It turns out to also affect _HASH in that it too gives an incorrect result on blessed hashes in non-PP mode. Attached to this ticket are tests which expose this issue and patches for the problem. Cheers, Paul
Subject: 0002-t-Adding-tests-of-blessed-hashes.patch
From 2755162ff6a8867d3f2daa90a6004a78df5c37a1 Mon Sep 17 00:00:00 2001 From: Paul Cochrane <paul@liekut.de> Date: Thu, 29 May 2014 11:33:45 +0200 Subject: [PATCH 2/4] [t] Adding tests of blessed hashes This is a corollary to the issue mentioned in RT#75561. It turns out that the XS code can't determine if the input is a blessed hash (in the case of the ticket, a blessed array) and thus returns the blessed hash (array) instead of undef. This test exposes this issue. --- t/02_main.t | 6 +++++- t/12_main.t | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/t/02_main.t b/t/02_main.t index 60c0eb1..b7a81bd 100644 --- a/t/02_main.t +++ b/t/02_main.t @@ -7,7 +7,7 @@ BEGIN { $ENV{PERL_PARAMS_UTIL_PP} ||= 0; } -use Test::More tests => 634; +use Test::More tests => 636; use File::Spec::Functions ':ALL'; use Scalar::Util 'refaddr'; use Params::Util (); @@ -539,6 +539,8 @@ null( Params::Util::_HASH(\'foo'), '...::_HASH(SCALAR) returns undef' ); null( Params::Util::_HASH([ 'foo' ]), '...::_HASH(ARRAY) returns undef' ); null( Params::Util::_HASH(sub () { 1 }), '...::_HASH(CODE) returns undef' ); null( Params::Util::_HASH({}), '...::_HASH(empty HASH) returns undef' ); +null( Params::Util::_HASH(bless({"foo" => "bar"}, "TEST")), + '...::_HASH(blessed HASH) returns undef' ); # Test good things against the actual function (carefully) is( ref(Params::Util::_HASH({ foo => 1 })), 'HASH', '...::_HASH([undef]) returns ok' ); @@ -563,6 +565,8 @@ null( _HASH(\'foo'), '_HASH(SCALAR) returns undef' ); null( _HASH([]), '_HASH(ARRAY) returns undef' ); null( _HASH(sub () { 1 }), '_HASH(CODE) returns undef' ); null( _HASH({}), '...::_HASH(empty HASH) returns undef' ); +null( _HASH(bless({"foo" => "bar"}, "TEST")), + '_HASH(blessed HASH) returns undef' ); # Test good things against the actual function (carefully) is( ref(_HASH({ foo => 1 })), 'HASH', '_HASH([undef]) returns true' ); diff --git a/t/12_main.t b/t/12_main.t index 6a2358c..6ce6e52 100644 --- a/t/12_main.t +++ b/t/12_main.t @@ -7,7 +7,7 @@ BEGIN { $ENV{PERL_PARAMS_UTIL_PP} ||= 1; } -use Test::More tests => 634; +use Test::More tests => 636; use File::Spec::Functions ':ALL'; use Scalar::Util 'refaddr'; use Params::Util (); @@ -539,6 +539,8 @@ null( Params::Util::_HASH(\'foo'), '...::_HASH(SCALAR) returns undef' ); null( Params::Util::_HASH([ 'foo' ]), '...::_HASH(ARRAY) returns undef' ); null( Params::Util::_HASH(sub () { 1 }), '...::_HASH(CODE) returns undef' ); null( Params::Util::_HASH({}), '...::_HASH(empty HASH) returns undef' ); +null( Params::Util::_HASH(bless({"foo" => "bar"}, "TEST")), + '...::_HASH(blessed HASH) returns undef' ); # Test good things against the actual function (carefully) is( ref(Params::Util::_HASH({ foo => 1 })), 'HASH', '...::_HASH([undef]) returns ok' ); @@ -563,6 +565,8 @@ null( _HASH(\'foo'), '_HASH(SCALAR) returns undef' ); null( _HASH([]), '_HASH(ARRAY) returns undef' ); null( _HASH(sub () { 1 }), '_HASH(CODE) returns undef' ); null( _HASH({}), '...::_HASH(empty HASH) returns undef' ); +null( _HASH(bless({"foo" => "bar"}, "TEST")), + '_HASH(blessed HASH) returns undef' ); # Test good things against the actual function (carefully) is( ref(_HASH({ foo => 1 })), 'HASH', '_HASH([undef]) returns true' ); -- 1.7.10.4
Subject: 0001-t-RT-75561-Adding-tests-for-blessed-arrays.patch
From 6124e7dfcee5929649b07ea15659773d7eeee110 Mon Sep 17 00:00:00 2001 From: Paul Cochrane <paul@liekut.de> Date: Thu, 29 May 2014 11:31:50 +0200 Subject: [PATCH 1/4] [t] RT#75561 Adding tests for blessed arrays Thanks to AUBERTG for pointing this out. --- t/02_main.t | 6 +++++- t/12_main.t | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/t/02_main.t b/t/02_main.t index 64ef1e4..60c0eb1 100644 --- a/t/02_main.t +++ b/t/02_main.t @@ -7,7 +7,7 @@ BEGIN { $ENV{PERL_PARAMS_UTIL_PP} ||= 0; } -use Test::More tests => 632; +use Test::More tests => 634; use File::Spec::Functions ':ALL'; use Scalar::Util 'refaddr'; use Params::Util (); @@ -439,6 +439,8 @@ null( Params::Util::_ARRAY(\'foo'), '...::_ARRAY(SCALAR) returns undef' ); null( Params::Util::_ARRAY({ foo => 1 }), '...::_ARRAY(HASH) returns undef' ); null( Params::Util::_ARRAY(sub () { 1 }), '...::_ARRAY(CODE) returns undef' ); null( Params::Util::_ARRAY([]), '...::_ARRAY(empty ARRAY) returns undef' ); +null( Params::Util::_ARRAY(bless([1, 2, 3], "TEST")), + '...::_ARRAY(blessed ARRAY) returns undef' ); # Test good things against the actual function (carefully) is( ref(Params::Util::_ARRAY([ undef ])), 'ARRAY', '...::_ARRAY([undef]) returns true' ); @@ -461,6 +463,8 @@ null( _ARRAY(\'foo'), '_ARRAY(SCALAR) returns undef' ); null( _ARRAY({ foo => 1 }), '_ARRAY(HASH) returns undef' ); null( _ARRAY(sub () { 1 }), '_ARRAY(CODE) returns undef' ); null( _ARRAY([]), '_ARRAY(empty ARRAY) returns undef' ); +null( _ARRAY(bless([1, 2, 3], "TEST")), + '_ARRAY(blessed ARRAY) returns undef' ); # Test good things against the actual function (carefully) is( ref(_ARRAY([ undef ])), 'ARRAY', '_ARRAY([undef]) returns true' ); diff --git a/t/12_main.t b/t/12_main.t index d8cf68f..6a2358c 100644 --- a/t/12_main.t +++ b/t/12_main.t @@ -7,7 +7,7 @@ BEGIN { $ENV{PERL_PARAMS_UTIL_PP} ||= 1; } -use Test::More tests => 632; +use Test::More tests => 634; use File::Spec::Functions ':ALL'; use Scalar::Util 'refaddr'; use Params::Util (); @@ -439,6 +439,8 @@ null( Params::Util::_ARRAY(\'foo'), '...::_ARRAY(SCALAR) returns undef' ); null( Params::Util::_ARRAY({ foo => 1 }), '...::_ARRAY(HASH) returns undef' ); null( Params::Util::_ARRAY(sub () { 1 }), '...::_ARRAY(CODE) returns undef' ); null( Params::Util::_ARRAY([]), '...::_ARRAY(empty ARRAY) returns undef' ); +null( Params::Util::_ARRAY( bless([1, 2, 3], "TEST") ), + '...::_ARRAY(blessed ARRAY) returns undef' ); # Test good things against the actual function (carefully) is( ref(Params::Util::_ARRAY([ undef ])), 'ARRAY', '...::_ARRAY([undef]) returns true' ); @@ -461,6 +463,8 @@ null( _ARRAY(\'foo'), '_ARRAY(SCALAR) returns undef' ); null( _ARRAY({ foo => 1 }), '_ARRAY(HASH) returns undef' ); null( _ARRAY(sub () { 1 }), '_ARRAY(CODE) returns undef' ); null( _ARRAY([]), '_ARRAY(empty ARRAY) returns undef' ); +null( _ARRAY( bless([1, 2, 3], "TEST") ), + '_ARRAY(blessed ARRAY) returns undef' ); # Test good things against the actual function (carefully) is( ref(_ARRAY([ undef ])), 'ARRAY', '_ARRAY([undef]) returns true' ); -- 1.7.10.4
Subject: 0004-Ensuring-_HASH-arg-isn-t-already-blessed.patch
From d4301ed655457e519b1f6d9946c4327190fa84ea Mon Sep 17 00:00:00 2001 From: Paul Cochrane <paul@liekut.de> Date: Thu, 29 May 2014 11:46:46 +0200 Subject: [PATCH 4/4] Ensuring _HASH arg isn't already blessed This makes the blessed hash tests pass and corrects the related issue found while investigating RT#75561. --- Util.xs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Util.xs b/Util.xs index 0f163d9..2cdde10 100644 --- a/Util.xs +++ b/Util.xs @@ -252,7 +252,7 @@ CODE: { if( SvMAGICAL(ref) ) mg_get(ref); - if( is_hash(ref) && ( HvKEYS(SvRV(ref)) >= 1 ) ) + if( is_hash(ref) && ( HvKEYS(SvRV(ref)) >= 1 ) && !sv_isobject(ref) ) { ST(0) = ref; XSRETURN(1); -- 1.7.10.4
Subject: 0003-Ensuring-_ARRAY-arg-isn-t-already-blessed.patch
From b0cd4f7f69ac7cff72e098eb8a4551f9a852bca3 Mon Sep 17 00:00:00 2001 From: Paul Cochrane <paul@liekut.de> Date: Thu, 29 May 2014 11:45:05 +0200 Subject: [PATCH 3/4] Ensuring _ARRAY arg isn't already blessed This makes the blessed array tests pass and corrects the issue found in RT#75561. --- Util.xs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Util.xs b/Util.xs index 7f63cbc..0f163d9 100644 --- a/Util.xs +++ b/Util.xs @@ -199,7 +199,7 @@ CODE: { if( SvMAGICAL(ref) ) mg_get(ref); - if( is_array(ref) && ( av_len((AV *)(SvRV(ref))) >= 0 ) ) + if( is_array(ref) && ( av_len((AV *)(SvRV(ref))) >= 0 ) && !sv_isobject(ref) ) { ST(0) = ref; XSRETURN(1); -- 1.7.10.4
  Thu May 29 05:53:24 2014 The RT System itself - Status changed from 'new' to 'open'
  Thu Oct 01 01:46:56 2020 REHSACK [...] cpan.org - Correspondence added
I'm unsure whether the XS or the PP code is wrong. I did some basic tests using Readonly (see RT#133158) $ env PERL_PARAMS_UTIL_PP=1 perl -Mblib -MDDP -MParams::Util=_HASH -MReadonly -e 'printf("%d\n", Params::Util::_XScompiled); my $h; Readonly $h => {foo => "bar"}; p($h); my $_h = _HASH($h); p($_h);' 0 "HASH(0x563d55fe9758)" (tied to Readonly::Scalar) \ { foo "bar" } $ env PERL_PARAMS_UTIL_PP=0 perl -Mblib -MDDP -MParams::Util=_HASH -MReadonly -e 'printf("%d\n", Params::Util::_XScompiled); my $h; Readonly $h => {foo => "bar"}; p($h); my $_h = _HASH($h); p($_h);' 1 "HASH(0x55affe150758)" (tied to Readonly::Scalar) \ { foo "bar" } From my understanding (but I might be fundamentally wrong, so no worries to guide me into right direction) this is a case for _ARRAYLIKE instead of _ARRAY, isn't it? Cheers, Jens
  Thu Oct 01 01:46:56 2020 REHSACK [...] cpan.org - Reference to ticket #133158 added