diff --git a/MANIFEST b/MANIFEST index 663ec3885287..876bda966bc7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1977,6 +1977,7 @@ cpan/Scalar-List-Utils/multicall.h Util extension cpan/Scalar-List-Utils/t/00version.t Scalar::Util cpan/Scalar-List-Utils/t/any-all.t List::Util cpan/Scalar-List-Utils/t/blessed.t Scalar::Util +cpan/Scalar-List-Utils/t/boolean.t Scalar::Util cpan/Scalar-List-Utils/t/dualvar.t Scalar::Util cpan/Scalar-List-Utils/t/exotic_names.t cpan/Scalar-List-Utils/t/first.t List::Util diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs index 2ce9085569ff..0c1385b60285 100644 --- a/cpan/Scalar-List-Utils/ListUtil.xs +++ b/cpan/Scalar-List-Utils/ListUtil.xs @@ -1665,6 +1665,19 @@ PPCODE: MODULE=List::Util PACKAGE=Scalar::Util +void +isbool(sv) + SV *sv +PROTOTYPE: $ +CODE: +#ifdef SvIsBOOL + SvGETMAGIC(sv); + ST(0) = boolSV(SvIsBOOL(sv)); + XSRETURN(1); +#else + croak("stable boolean values are not implemented in this release of perl"); +#endif + void dualvar(num,str) SV *num @@ -2119,6 +2132,9 @@ BOOT: #ifndef SvVOK av_push(varav, newSVpv("isvstring",9)); #endif +#ifndef SvIsBOOL + av_push(varav, newSVpv("isbool",6)); +#endif #ifdef REAL_MULTICALL sv_setsv(rmcsv, &PL_sv_yes); #else diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm index dad5357f4329..71f36f195608 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util.pm @@ -16,7 +16,7 @@ our @EXPORT_OK = qw( sample shuffle uniq uniqint uniqnum uniqstr zip zip_longest zip_shortest mesh mesh_longest mesh_shortest head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst ); -our $VERSION = "1.56"; +our $VERSION = "1.56_001"; our $XS_VERSION = $VERSION; $VERSION =~ tr/_//d; diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm index 70d33131cc6f..77cb68fc97e9 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm @@ -3,7 +3,7 @@ use strict; use warnings; use List::Util; -our $VERSION = "1.56"; # FIXUP +our $VERSION = "1.56_001"; # FIXUP $VERSION =~ tr/_//d; # FIXUP 1; diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm index de3e892298a9..6bf01d3f98d6 100644 --- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm @@ -14,10 +14,12 @@ our @ISA = qw(Exporter); our @EXPORT_OK = qw( blessed refaddr reftype weaken unweaken isweak + isbool + dualvar isdual isvstring looks_like_number openhandle readonly set_prototype tainted ); -our $VERSION = "1.56"; +our $VERSION = "1.56_001"; $VERSION =~ tr/_//d; require List::Util; # List::Util loads the XS @@ -217,6 +219,16 @@ B: Copying a weak reference creates a normal, strong, reference. =head1 OTHER FUNCTIONS +=head2 isbool + + my $bool = isbool( $var ); + +I + +Returns true if the given variable is boolean in nature - that is, it is the +result of a boolean operator (such as C, C, or a numerical or +string comparison), or is a variable that is copied from one. + =head2 dualvar my $var = dualvar( $num, $string ); diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm index 1eee0ded4163..8b25af75445f 100644 --- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm @@ -15,7 +15,7 @@ our @EXPORT_OK = qw( subname set_subname ); -our $VERSION = "1.56"; +our $VERSION = "1.56_001"; $VERSION =~ tr/_//d; require List::Util; # as it has the XS diff --git a/cpan/Scalar-List-Utils/t/boolean.t b/cpan/Scalar-List-Utils/t/boolean.t new file mode 100644 index 000000000000..691734ea8e29 --- /dev/null +++ b/cpan/Scalar-List-Utils/t/boolean.t @@ -0,0 +1,64 @@ +#!./perl + +use strict; +use warnings; + +use Scalar::Util (); +use Test::More (grep { /isbool/ } @Scalar::Util::EXPORT_FAIL) + ? (skip_all => 'isbool requires XS version') + : (tests => 15); + +Scalar::Util->import("isbool"); + +# basic constants +{ + ok(isbool(!!0), 'false is boolean'); + ok(isbool(!!1), 'true is boolean'); + + ok(!isbool(0), '0 is not boolean'); + ok(!isbool(1), '1 is not boolean'); + ok(!isbool(""), '"" is not boolean'); +} + +# variables +{ + my $falsevar = !!0; + my $truevar = !!1; + + ok(isbool($falsevar), 'false var is boolean'); + ok(isbool($truevar), 'true var is boolean'); + + my $str = "$truevar"; + my $num = $truevar + 0; + + ok(!isbool($str), 'stringified true is not boolean'); + ok(!isbool($num), 'numified true is not boolean'); + + ok(isbool($truevar), 'true var remains boolean after stringification and numification'); +} + +# aggregate members +{ + my %hash = ( false => !!0, true => !!1 ); + + ok(isbool($hash{false}), 'false HELEM is boolean'); + ok(isbool($hash{true}), 'true HELEM is boolean'); + + # We won't test AELEM but it's likely to be the same +} + +{ + my $var; + package Foo { sub TIESCALAR { bless {}, shift } sub FETCH { $var } } + + tie my $tied, "Foo"; + + $var = 1; + ok(!isbool($tied), 'tied var should not yet be boolean'); + + $var = !!1; + ok(isbool($tied), 'tied var should now be boolean'); + + my $copy = $tied; + ok(isbool($copy), 'copy of tied var should also be boolean'); +}