Skip Menu |

This queue is for tickets about the Scalar-List-Utils CPAN distribution.

Report information
The Basics
Id: 76150
Status: resolved
Priority: 0/
Queue: Scalar-List-Utils

People
Owner: Nobody in particular
Requestors: brianski [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: 1.25
Fixed in: 1.26



Subject: Detecting dualvars
Is there a nice way to detect dualvars? Seems like a whole in the API (compare weaken and isweak). Right now I'm using the following mess, which I'm quite sure is subtly wrong or at least not optimal: sub is_dualvar { my ($x) = @_; return "$x" ne 0+$x; }; ... it sure seems like there should be an XS-tastic way to do the job in Scalar::Util itself faster and hidden under the covers...
Subject: Re: [rt.cpan.org #76150] Detecting dualvars
Date: Fri, 30 Mar 2012 11:08:13 -0500
To: bug-Scalar-List-Utils [...] rt.cpan.org
From: Graham Barr <gbarr [...] pobox.com>
Every scalar in perl is a dualvar as perl caches the numeric and string forms when it calculates them. dualvar() just abuses that feature in the same way that $! does for example $ perl -le '$x="123 "; print "is_dualvar" if "$x" ne 0+$x' is_dualvar there is no way to detect any difference between this $x and one created with dualvar() Graham.
Right, but the condition I am interested in testing isn't "was it created with Scalar::Util::dualvar()", but rather: if I dump the string version of this variable to a text file / DB / whatever, will I lose any information? On Fri Mar 30 12:08:26 2012, gbarr@pobox.com wrote: Show quoted text
> Every scalar in perl is a dualvar as perl caches the numeric and > string forms when it calculates them. > > dualvar() just abuses that feature in the same way that $! does > > for example > > $ perl -le '$x="123 "; print "is_dualvar" if "$x" ne 0+$x' > is_dualvar > > there is no way to detect any difference between this $x and one > created with dualvar() > > Graham. >
On Fri Mar 30 14:33:52 2012, BRIANSKI wrote: Show quoted text
> Right, but the condition I am interested in testing isn't "was it > created with Scalar::Util::dualvar()", but rather: if I dump the string > version of this variable to a text file / DB / whatever, will I lose any > information?
Ultimately then, this comes down to a question of whether the variable has both numeric and stringy parts to it, that represent different values. You can likely come up with some pureperl to detect that, something like do { no warnings; sprintf("%s", $var) eq sprintf("%f", $var); } Some XS could optimise that by noting that only a dualvar has both SvIOK/SvNOK and SvPOK set at once, so if it only has one it never has to test this. Then the test merely has to distinguish "normal" SVs with both slots precached, vs. genuine dualvars containing different data. Of course you'll never distinguish such cases as dualvar(10, "10") Since your original condition only cares about numeric vs. stringy data, perhaps you'd be best to test that using some sprintf tests, rather than XS-level hacks. -- Paul Evans
Subject: [PATCH] Detecting dualvars
Attached is a patch that adds an 'isdual()' boolean function to Scalar::Util. Documentation has been added to the POD, and tests have been added to t/dualvar.t. I have generated this patch so that the threads::shared module can use this new function to test for dual-valued variables, and handle them appropriately with cloning them.
Subject: isdual.patch
diff -urN Scalar-List-Utils-1.25/ListUtil.xs Scalar-List-Utils-patched/ListUtil.xs --- Scalar-List-Utils-1.25/ListUtil.xs 2012-03-24 09:08:41.000000000 -0400 +++ Scalar-List-Utils-patched/ListUtil.xs 2012-10-01 10:45:08.315467000 -0400 @@ -397,6 +397,14 @@ XSRETURN(1); } +void +isdual(sv) + SV *sv +PROTOTYPE: $ +CODE: + ST(0) = boolSV(SvPOK(sv) && (SvNOK(sv) || SvIOK(sv))); + XSRETURN(1); + char * blessed(sv) SV * sv diff -urN Scalar-List-Utils-1.25/lib/Scalar/Util.pm Scalar-List-Utils-patched/lib/Scalar/Util.pm --- Scalar-List-Utils-1.25/lib/Scalar/Util.pm 2012-03-24 09:10:46.000000000 -0400 +++ Scalar-List-Utils-patched/lib/Scalar/Util.pm 2012-10-01 11:15:08.198678200 -0400 @@ -11,7 +11,7 @@ require List::Util; # List::Util loads the XS our @ISA = qw(Exporter); -our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); +our @EXPORT_OK = qw(blessed dualvar isdual reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); our $VERSION = "1.25"; $VERSION = eval $VERSION; @@ -51,8 +51,9 @@ =head1 SYNOPSIS - use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted - weaken isvstring looks_like_number set_prototype); + use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype + tainted weaken isweak isvstring looks_like_number + set_prototype); # and other useful utils appearing below =head1 DESCRIPTION @@ -90,27 +91,40 @@ $num = $foo + 2; # 12 $str = $foo . " world"; # Hello world -=item isvstring EXPR +=item isdual EXPR -If EXPR is a scalar which was coded as a vstring the result is true. +If EXPR is a scalar that is a dualvar, the result is true. - $vs = v49.46.48; - $fmt = isvstring($vs) ? "%vd" : "%s"; #true - printf($fmt,$vs); + $foo = dualvar 86, "Nix"; + $dual = isdual($foo); # true -=item isweak EXPR +Note that a scalar can be made to have both string and numeric content +through numeric operations: -If EXPR is a scalar which is a weak reference the result is true. + $foo = "10"; + $dual = isdual($foo); # false + $bar = $foo + 0; + $dual = isdual($foo); # true - $ref = \$foo; - $weak = isweak($ref); # false - weaken($ref); - $weak = isweak($ref); # true +Note that although C<$!> appears to be dual-valued variable, it is +actually implemented using a tied scalar: -B<NOTE>: Copying a weak reference creates a normal, strong, reference. + $! = 1; + print("$!\n"); # "Operation not permitted" + $dual = isdual($!); # false - $copy = $ref; - $weak = isweak($copy); # false +You can capture its numeric and string content using: + + $err = dualvar $!, $!; + $dual = isdual($err); # true + +=item isvstring EXPR + +If EXPR is a scalar which was coded as a vstring the result is true. + + $vs = v49.46.48; + $fmt = isvstring($vs) ? "%vd" : "%s"; #true + printf($fmt,$vs); =item looks_like_number EXPR @@ -122,11 +136,11 @@ Returns FH if FH may be used as a filehandle and is open, or FH is a tied handle. Otherwise C<undef> is returned. - $fh = openhandle(*STDIN); # \*STDIN - $fh = openhandle(\*STDIN); # \*STDIN - $fh = openhandle(*NOTOPEN); # undef - $fh = openhandle("scalar"); # undef - + $fh = openhandle(*STDIN); # \*STDIN + $fh = openhandle(\*STDIN); # \*STDIN + $fh = openhandle(*NOTOPEN); # undef + $fh = openhandle("scalar"); # undef + =item readonly SCALAR Returns true if SCALAR is readonly. @@ -209,6 +223,20 @@ be destroyed because there is now always a strong reference to them in the @object array. +=item isweak EXPR + +If EXPR is a scalar which is a weak reference the result is true. + + $ref = \$foo; + $weak = isweak($ref); # false + weaken($ref); + $weak = isweak($ref); # true + +B<NOTE>: Copying a weak reference creates a normal, strong, reference. + + $copy = $ref; + $weak = isweak($copy); # false + =back =head1 DIAGNOSTICS diff -urN Scalar-List-Utils-1.25/t/dualvar.t Scalar-List-Utils-patched/t/dualvar.t --- Scalar-List-Utils-1.25/t/dualvar.t 2012-03-22 14:05:13.000000000 -0400 +++ Scalar-List-Utils-patched/t/dualvar.t 2012-10-01 11:01:16.256202200 -0400 @@ -16,22 +16,26 @@ use Scalar::Util (); use Test::More (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) ? (skip_all => 'dualvar requires XS version') - : (tests => 13); + : (tests => 21); Scalar::Util->import('dualvar'); +Scalar::Util->import('isdual'); $var = dualvar( 2.2,"string"); +ok( isdual($var), 'Is a dualvar'); ok( $var == 2.2, 'Numeric value'); ok( $var eq "string", 'String value'); $var2 = $var; +ok( isdual($var2), 'Is a dualvar'); ok( $var2 == 2.2, 'copy Numeric value'); ok( $var2 eq "string", 'copy String value'); $var++; +ok( ! isdual($var), 'No longer dualvar'); ok( $var == 3.2, 'inc Numeric value'); ok( $var ne "string", 'inc String value'); @@ -40,15 +44,22 @@ $var = dualvar($numstr, ""); +ok( isdual($var), 'Is a dualvar'); ok( $var == $numstr, 'NV'); SKIP: { skip("dualvar with UV value known to fail with $]",2) if $] < 5.006_001; $var = dualvar(1<<31, ""); + ok( isdual($var), 'Is a dualvar'); ok( $var == (1<<31), 'UV 1'); ok( $var > 0, 'UV 2'); } +# Create a dualvar "the old fashioned way" +$var = "10"; +ok( ! isdual($var), 'Not a dualvar'); +my $foo = $var + 0; +ok( isdual($var), 'Is a dualvar'); { package Tied; @@ -59,12 +70,13 @@ tie my $tied, 'Tied'; $var = dualvar($tied, "ok"); +ok(isdual($var), 'Is a dualvar'); ok($var == 7.5, 'Tied num'); ok($var eq 'ok', 'Tied str'); SKIP: { - skip("need utf8::is_utf8",2) unless defined &utf8::is_utf8; + skip("need utf8::is_utf8",3) unless defined &utf8::is_utf8; ok(!!utf8::is_utf8(dualvar(1,chr(400))), 'utf8'); ok( !utf8::is_utf8(dualvar(1,"abc")), 'not utf8'); }
Subject: [PATCH] Detecting dualvars (revised)
On 2012-10-01 11:23:11, JDHEDDEN wrote: Show quoted text
> Attached is a patch that adds an 'isdual()' boolean function to > Scalar::Util. Documentation has been added to the POD, and tests have > been added to t/dualvar.t.
The attached patch is much improved, and handles shared variables along. Additional tests are included.
Subject: isdual.patch
diff -urN Scalar-List-Utils-1.25/ListUtil.xs Scalar-List-Utils-patched/ListUtil.xs --- Scalar-List-Utils-1.25/ListUtil.xs 2012-03-24 09:08:41.000000000 -0400 +++ Scalar-List-Utils-patched/ListUtil.xs 2012-10-02 16:13:54.703585900 -0400 @@ -397,6 +397,16 @@ XSRETURN(1); } +void +isdual(sv) + SV *sv +PROTOTYPE: $ +CODE: + if (SvMAGICAL(sv)) + mg_get(sv); + ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv))); + XSRETURN(1); + char * blessed(sv) SV * sv diff -urN Scalar-List-Utils-1.25/lib/Scalar/Util.pm Scalar-List-Utils-patched/lib/Scalar/Util.pm --- Scalar-List-Utils-1.25/lib/Scalar/Util.pm 2012-03-24 09:10:46.000000000 -0400 +++ Scalar-List-Utils-patched/lib/Scalar/Util.pm 2012-10-01 11:15:08.198678200 -0400 @@ -11,7 +11,7 @@ require List::Util; # List::Util loads the XS our @ISA = qw(Exporter); -our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); +our @EXPORT_OK = qw(blessed dualvar isdual reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); our $VERSION = "1.25"; $VERSION = eval $VERSION; @@ -51,8 +51,9 @@ =head1 SYNOPSIS - use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted - weaken isvstring looks_like_number set_prototype); + use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype + tainted weaken isweak isvstring looks_like_number + set_prototype); # and other useful utils appearing below =head1 DESCRIPTION @@ -90,27 +91,40 @@ $num = $foo + 2; # 12 $str = $foo . " world"; # Hello world -=item isvstring EXPR +=item isdual EXPR -If EXPR is a scalar which was coded as a vstring the result is true. +If EXPR is a scalar that is a dualvar, the result is true. - $vs = v49.46.48; - $fmt = isvstring($vs) ? "%vd" : "%s"; #true - printf($fmt,$vs); + $foo = dualvar 86, "Nix"; + $dual = isdual($foo); # true -=item isweak EXPR +Note that a scalar can be made to have both string and numeric content +through numeric operations: -If EXPR is a scalar which is a weak reference the result is true. + $foo = "10"; + $dual = isdual($foo); # false + $bar = $foo + 0; + $dual = isdual($foo); # true - $ref = \$foo; - $weak = isweak($ref); # false - weaken($ref); - $weak = isweak($ref); # true +Note that although C<$!> appears to be dual-valued variable, it is +actually implemented using a tied scalar: -B<NOTE>: Copying a weak reference creates a normal, strong, reference. + $! = 1; + print("$!\n"); # "Operation not permitted" + $dual = isdual($!); # false - $copy = $ref; - $weak = isweak($copy); # false +You can capture its numeric and string content using: + + $err = dualvar $!, $!; + $dual = isdual($err); # true + +=item isvstring EXPR + +If EXPR is a scalar which was coded as a vstring the result is true. + + $vs = v49.46.48; + $fmt = isvstring($vs) ? "%vd" : "%s"; #true + printf($fmt,$vs); =item looks_like_number EXPR @@ -122,11 +136,11 @@ Returns FH if FH may be used as a filehandle and is open, or FH is a tied handle. Otherwise C<undef> is returned. - $fh = openhandle(*STDIN); # \*STDIN - $fh = openhandle(\*STDIN); # \*STDIN - $fh = openhandle(*NOTOPEN); # undef - $fh = openhandle("scalar"); # undef - + $fh = openhandle(*STDIN); # \*STDIN + $fh = openhandle(\*STDIN); # \*STDIN + $fh = openhandle(*NOTOPEN); # undef + $fh = openhandle("scalar"); # undef + =item readonly SCALAR Returns true if SCALAR is readonly. @@ -209,6 +223,20 @@ be destroyed because there is now always a strong reference to them in the @object array. +=item isweak EXPR + +If EXPR is a scalar which is a weak reference the result is true. + + $ref = \$foo; + $weak = isweak($ref); # false + weaken($ref); + $weak = isweak($ref); # true + +B<NOTE>: Copying a weak reference creates a normal, strong, reference. + + $copy = $ref; + $weak = isweak($copy); # false + =back =head1 DIAGNOSTICS diff -urN Scalar-List-Utils-1.25/t/dualvar.t Scalar-List-Utils-patched/t/dualvar.t --- Scalar-List-Utils-1.25/t/dualvar.t 2012-03-22 14:05:13.000000000 -0400 +++ Scalar-List-Utils-patched/t/dualvar.t 2012-10-02 16:14:26.578789900 -0400 @@ -16,22 +16,27 @@ use Scalar::Util (); use Test::More (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) ? (skip_all => 'dualvar requires XS version') - : (tests => 13); + : (tests => 41); +use Config; Scalar::Util->import('dualvar'); +Scalar::Util->import('isdual'); $var = dualvar( 2.2,"string"); +ok( isdual($var), 'Is a dualvar'); ok( $var == 2.2, 'Numeric value'); ok( $var eq "string", 'String value'); $var2 = $var; +ok( isdual($var2), 'Is a dualvar'); ok( $var2 == 2.2, 'copy Numeric value'); ok( $var2 eq "string", 'copy String value'); $var++; +ok( ! isdual($var), 'No longer dualvar'); ok( $var == 3.2, 'inc Numeric value'); ok( $var ne "string", 'inc String value'); @@ -40,15 +45,23 @@ $var = dualvar($numstr, ""); +ok( isdual($var), 'Is a dualvar'); ok( $var == $numstr, 'NV'); SKIP: { skip("dualvar with UV value known to fail with $]",2) if $] < 5.006_001; - $var = dualvar(1<<31, ""); - ok( $var == (1<<31), 'UV 1'); - ok( $var > 0, 'UV 2'); + my $bits = ($Config{'use64bitint'}) ? 63 : 31; + $var = dualvar(1<<$bits, ""); + ok( isdual($var), 'Is a dualvar'); + ok( $var == (1<<$bits), 'UV 1'); + ok( $var > 0, 'UV 2'); } +# Create a dualvar "the old fashioned way" +$var = "10"; +ok( ! isdual($var), 'Not a dualvar'); +my $foo = $var + 0; +ok( isdual($var), 'Is a dualvar'); { package Tied; @@ -59,12 +72,54 @@ tie my $tied, 'Tied'; $var = dualvar($tied, "ok"); +ok(isdual($var), 'Is a dualvar'); ok($var == 7.5, 'Tied num'); ok($var eq 'ok', 'Tied str'); SKIP: { - skip("need utf8::is_utf8",2) unless defined &utf8::is_utf8; + skip("need utf8::is_utf8",3) unless defined &utf8::is_utf8; ok(!!utf8::is_utf8(dualvar(1,chr(400))), 'utf8'); ok( !utf8::is_utf8(dualvar(1,"abc")), 'not utf8'); } + + +SKIP: { + skip("Perl not compiled with 'useithreads'",7) unless ($Config{'useithreads'}); + require threads; import threads; + require threads::shared; import threads::shared; + skip("Requires threads::shared v1.42 or later",7) unless ($threads::shared::VERSION >= 1.42); + + my $siv :shared = dualvar(42, 'Fourty-Two'); + my $snv :shared = dualvar(3.14, 'PI'); + my $bits = ($Config{'use64bitint'}) ? 63 : 31; + my $suv :shared = dualvar(1<<$bits, 'Large unsigned int'); + + ok($siv == 42, 'Shared IV number preserved'); + ok($siv eq 'Fourty-Two', 'Shared string preserved'); + ok(isdual($siv), 'Is a dualvar'); + ok($snv == 3.14, 'Shared NV number preserved'); + ok($snv eq 'PI', 'Shared string preserved'); + ok(isdual($snv), 'Is a dualvar'); + ok($suv == (1<<$bits), 'Shared UV number preserved'); + ok($suv > 0, 'Shared UV number preserved'); + ok($suv eq 'Large unsigned int', 'Shared string preserved'); + ok(isdual($suv), 'Is a dualvar'); + + my @ary :shared; + $ary[0] = $siv; + $ary[1] = $snv; + $ary[2] = $suv; + + ok($ary[0] == 42, 'Shared IV number preserved'); + ok($ary[0] eq 'Fourty-Two', 'Shared string preserved'); + ok(isdual($ary[0]), 'Is a dualvar'); + ok($ary[1] == 3.14, 'Shared NV number preserved'); + ok($ary[1] eq 'PI', 'Shared string preserved'); + ok(isdual($ary[1]), 'Is a dualvar'); + ok($ary[2] == (1<<$bits), 'Shared UV number preserved'); + ok($ary[2] > 0, 'Shared UV number preserved'); + ok($ary[2] eq 'Large unsigned int', 'Shared string preserved'); + ok(isdual($ary[2]), 'Is a dualvar'); +} +
Subject: [PATCH] Detecting dualvars (revised^2)
RT-Send-CC: gbarr [...] pobox.com
On 2012-10-01 11:23:11, JDHEDDEN wrote: Show quoted text
> Attached is a patch that adds an 'isdual()' boolean function to > Scalar::Util. Documentation has been added to the POD, and tests have > been added to t/dualvar.t.
The attached patch is much improved, and handles shared variables also. Additional tests are included. This revised^2 patch corrects the skip count in the tests added to t/dualvar.t.
Subject: isdual.patch
diff -urN Scalar-List-Utils-1.25/ListUtil.xs Scalar-List-Utils-patched/ListUtil.xs --- Scalar-List-Utils-1.25/ListUtil.xs 2012-03-24 09:08:41.000000000 -0400 +++ Scalar-List-Utils-patched/ListUtil.xs 2012-10-02 16:13:54.703585900 -0400 @@ -397,6 +397,16 @@ XSRETURN(1); } +void +isdual(sv) + SV *sv +PROTOTYPE: $ +CODE: + if (SvMAGICAL(sv)) + mg_get(sv); + ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv))); + XSRETURN(1); + char * blessed(sv) SV * sv diff -urN Scalar-List-Utils-1.25/lib/Scalar/Util.pm Scalar-List-Utils-patched/lib/Scalar/Util.pm --- Scalar-List-Utils-1.25/lib/Scalar/Util.pm 2012-03-24 09:10:46.000000000 -0400 +++ Scalar-List-Utils-patched/lib/Scalar/Util.pm 2012-10-01 11:15:08.198678200 -0400 @@ -11,7 +11,7 @@ require List::Util; # List::Util loads the XS our @ISA = qw(Exporter); -our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); +our @EXPORT_OK = qw(blessed dualvar isdual reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); our $VERSION = "1.25"; $VERSION = eval $VERSION; @@ -51,8 +51,9 @@ =head1 SYNOPSIS - use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted - weaken isvstring looks_like_number set_prototype); + use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype + tainted weaken isweak isvstring looks_like_number + set_prototype); # and other useful utils appearing below =head1 DESCRIPTION @@ -90,27 +91,40 @@ $num = $foo + 2; # 12 $str = $foo . " world"; # Hello world -=item isvstring EXPR +=item isdual EXPR -If EXPR is a scalar which was coded as a vstring the result is true. +If EXPR is a scalar that is a dualvar, the result is true. - $vs = v49.46.48; - $fmt = isvstring($vs) ? "%vd" : "%s"; #true - printf($fmt,$vs); + $foo = dualvar 86, "Nix"; + $dual = isdual($foo); # true -=item isweak EXPR +Note that a scalar can be made to have both string and numeric content +through numeric operations: -If EXPR is a scalar which is a weak reference the result is true. + $foo = "10"; + $dual = isdual($foo); # false + $bar = $foo + 0; + $dual = isdual($foo); # true - $ref = \$foo; - $weak = isweak($ref); # false - weaken($ref); - $weak = isweak($ref); # true +Note that although C<$!> appears to be dual-valued variable, it is +actually implemented using a tied scalar: -B<NOTE>: Copying a weak reference creates a normal, strong, reference. + $! = 1; + print("$!\n"); # "Operation not permitted" + $dual = isdual($!); # false - $copy = $ref; - $weak = isweak($copy); # false +You can capture its numeric and string content using: + + $err = dualvar $!, $!; + $dual = isdual($err); # true + +=item isvstring EXPR + +If EXPR is a scalar which was coded as a vstring the result is true. + + $vs = v49.46.48; + $fmt = isvstring($vs) ? "%vd" : "%s"; #true + printf($fmt,$vs); =item looks_like_number EXPR @@ -122,11 +136,11 @@ Returns FH if FH may be used as a filehandle and is open, or FH is a tied handle. Otherwise C<undef> is returned. - $fh = openhandle(*STDIN); # \*STDIN - $fh = openhandle(\*STDIN); # \*STDIN - $fh = openhandle(*NOTOPEN); # undef - $fh = openhandle("scalar"); # undef - + $fh = openhandle(*STDIN); # \*STDIN + $fh = openhandle(\*STDIN); # \*STDIN + $fh = openhandle(*NOTOPEN); # undef + $fh = openhandle("scalar"); # undef + =item readonly SCALAR Returns true if SCALAR is readonly. @@ -209,6 +223,20 @@ be destroyed because there is now always a strong reference to them in the @object array. +=item isweak EXPR + +If EXPR is a scalar which is a weak reference the result is true. + + $ref = \$foo; + $weak = isweak($ref); # false + weaken($ref); + $weak = isweak($ref); # true + +B<NOTE>: Copying a weak reference creates a normal, strong, reference. + + $copy = $ref; + $weak = isweak($copy); # false + =back =head1 DIAGNOSTICS diff -urN Scalar-List-Utils-1.25/t/dualvar.t Scalar-List-Utils-patched/t/dualvar.t --- Scalar-List-Utils-1.25/t/dualvar.t 2012-03-22 14:05:13.000000000 -0400 +++ Scalar-List-Utils-patched/t/dualvar.t 2012-10-02 16:14:26.578789900 -0400 @@ -16,22 +16,27 @@ use Scalar::Util (); use Test::More (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) ? (skip_all => 'dualvar requires XS version') - : (tests => 13); + : (tests => 41); +use Config; Scalar::Util->import('dualvar'); +Scalar::Util->import('isdual'); $var = dualvar( 2.2,"string"); +ok( isdual($var), 'Is a dualvar'); ok( $var == 2.2, 'Numeric value'); ok( $var eq "string", 'String value'); $var2 = $var; +ok( isdual($var2), 'Is a dualvar'); ok( $var2 == 2.2, 'copy Numeric value'); ok( $var2 eq "string", 'copy String value'); $var++; +ok( ! isdual($var), 'No longer dualvar'); ok( $var == 3.2, 'inc Numeric value'); ok( $var ne "string", 'inc String value'); @@ -40,15 +45,23 @@ $var = dualvar($numstr, ""); +ok( isdual($var), 'Is a dualvar'); ok( $var == $numstr, 'NV'); SKIP: { skip("dualvar with UV value known to fail with $]",2) if $] < 5.006_001; - $var = dualvar(1<<31, ""); - ok( $var == (1<<31), 'UV 1'); - ok( $var > 0, 'UV 2'); + my $bits = ($Config{'use64bitint'}) ? 63 : 31; + $var = dualvar(1<<$bits, ""); + ok( isdual($var), 'Is a dualvar'); + ok( $var == (1<<$bits), 'UV 1'); + ok( $var > 0, 'UV 2'); } +# Create a dualvar "the old fashioned way" +$var = "10"; +ok( ! isdual($var), 'Not a dualvar'); +my $foo = $var + 0; +ok( isdual($var), 'Is a dualvar'); { package Tied; @@ -59,12 +72,54 @@ tie my $tied, 'Tied'; $var = dualvar($tied, "ok"); +ok(isdual($var), 'Is a dualvar'); ok($var == 7.5, 'Tied num'); ok($var eq 'ok', 'Tied str'); SKIP: { - skip("need utf8::is_utf8",2) unless defined &utf8::is_utf8; + skip("need utf8::is_utf8",3) unless defined &utf8::is_utf8; ok(!!utf8::is_utf8(dualvar(1,chr(400))), 'utf8'); ok( !utf8::is_utf8(dualvar(1,"abc")), 'not utf8'); } + + +SKIP: { + skip("Perl not compiled with 'useithreads'",20) unless ($Config{'useithreads'}); + require threads; import threads; + require threads::shared; import threads::shared; + skip("Requires threads::shared v1.42 or later",20) unless ($threads::shared::VERSION >= 1.42); + + my $siv :shared = dualvar(42, 'Fourty-Two'); + my $snv :shared = dualvar(3.14, 'PI'); + my $bits = ($Config{'use64bitint'}) ? 63 : 31; + my $suv :shared = dualvar(1<<$bits, 'Large unsigned int'); + + ok($siv == 42, 'Shared IV number preserved'); + ok($siv eq 'Fourty-Two', 'Shared string preserved'); + ok(isdual($siv), 'Is a dualvar'); + ok($snv == 3.14, 'Shared NV number preserved'); + ok($snv eq 'PI', 'Shared string preserved'); + ok(isdual($snv), 'Is a dualvar'); + ok($suv == (1<<$bits), 'Shared UV number preserved'); + ok($suv > 0, 'Shared UV number preserved'); + ok($suv eq 'Large unsigned int', 'Shared string preserved'); + ok(isdual($suv), 'Is a dualvar'); + + my @ary :shared; + $ary[0] = $siv; + $ary[1] = $snv; + $ary[2] = $suv; + + ok($ary[0] == 42, 'Shared IV number preserved'); + ok($ary[0] eq 'Fourty-Two', 'Shared string preserved'); + ok(isdual($ary[0]), 'Is a dualvar'); + ok($ary[1] == 3.14, 'Shared NV number preserved'); + ok($ary[1] eq 'PI', 'Shared string preserved'); + ok(isdual($ary[1]), 'Is a dualvar'); + ok($ary[2] == (1<<$bits), 'Shared UV number preserved'); + ok($ary[2] > 0, 'Shared UV number preserved'); + ok($ary[2] eq 'Large unsigned int', 'Shared string preserved'); + ok(isdual($ary[2]), 'Is a dualvar'); +} +
Merged (with minor spacing modifications); in next release. -- Paul Evans