From d0a5ecaa9789935767a78a79b7830ffff24f524c Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Sat, 7 Aug 2021 15:11:40 +0100 Subject: Add a Scalar::Util::isbool() Remember to SvGETMAGIC() before testing SvIsBOOL() (thanks @tonycoz) Unit-test that booleaness is preserved on values passed in to, out of, or captured by threads --- cpan/Scalar-List-Utils/ListUtil.xs | 18 ++++++++- cpan/Scalar-List-Utils/lib/List/Util.pm | 2 +- cpan/Scalar-List-Utils/lib/List/Util/XS.pm | 2 +- cpan/Scalar-List-Utils/lib/Scalar/Util.pm | 32 ++++++++++++--- cpan/Scalar-List-Utils/lib/Sub/Util.pm | 2 +- cpan/Scalar-List-Utils/t/boolean-thr.t | 38 ++++++++++++++++++ cpan/Scalar-List-Utils/t/boolean.t | 64 ++++++++++++++++++++++++++++++ 7 files changed, 149 insertions(+), 9 deletions(-) create mode 100644 cpan/Scalar-List-Utils/t/boolean-thr.t create mode 100644 cpan/Scalar-List-Utils/t/boolean.t (limited to 'cpan/Scalar-List-Utils') diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs index 2ce9085569..bd655010d5 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 @@ -2101,7 +2114,7 @@ BOOT: HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE); GV *rmcgv = *(GV**)hv_fetch(lu_stash, "REAL_MULTICALL", 14, TRUE); SV *rmcsv; -#if !defined(SvWEAKREF) || !defined(SvVOK) +#if !defined(SvWEAKREF) || !defined(SvVOK) || !defined(SvIsBOOL) HV *su_stash = gv_stashpvn("Scalar::Util", 12, TRUE); GV *vargv = *(GV**)hv_fetch(su_stash, "EXPORT_FAIL", 11, TRUE); AV *varav; @@ -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 dad5357f43..71f36f1956 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 70d33131cc..77cb68fc97 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 de3e892298..feb59806c6 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 @@ -38,12 +40,17 @@ unless (defined &isvstring) { sub export_fail { if (grep { /^(?:weaken|isweak)$/ } @_ ) { require Carp; - Carp::croak("Weak references are not implemented in the version of perl"); + Carp::croak("Weak references are not implemented in this version of perl"); } if (grep { /^isvstring$/ } @_ ) { require Carp; - Carp::croak("Vstrings are not implemented in the version of perl"); + Carp::croak("Vstrings are not implemented in this version of perl"); + } + + if (grep { /^isbool$/ } @_ ) { + require Carp; + Carp::croak("isbool is not implemented in this version of perl"); } @_; @@ -217,6 +224,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 ); @@ -324,16 +341,21 @@ Module use may give one of the following errors during import. =over -=item Weak references are not implemented in the version of perl +=item Weak references are not implemented in this version of perl The version of perl that you are using does not implement weak references, to use L or L you will need to use a newer release of perl. -=item Vstrings are not implemented in the version of perl +=item Vstrings are not implemented in this version of perl The version of perl that you are using does not implement Vstrings, to use L you will need to use a newer release of perl. +=item isbool is not implemented in this version of perl + +The version of perl that you are using does not implement stable boolean +tracking, to use L you will need to use a newer release of perl. + =back =head1 KNOWN BUGS diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm index 1eee0ded41..8b25af7544 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-thr.t b/cpan/Scalar-List-Utils/t/boolean-thr.t new file mode 100644 index 0000000000..4b4073948c --- /dev/null +++ b/cpan/Scalar-List-Utils/t/boolean-thr.t @@ -0,0 +1,38 @@ +#!./perl + +use strict; +use warnings; + +use Config (); +use Scalar::Util (); +use Test::More + (grep { /isbool/ } @Scalar::Util::EXPORT_FAIL) ? (skip_all => 'isbool is not supported on this perl') : + (!$Config::Config{usethreads}) ? (skip_all => 'perl does not support threads') : + (tests => 5); + +use threads; +use threads::shared; + +Scalar::Util->import("isbool"); + +ok(threads->create( sub { isbool($_[0]) }, !!0 )->join, + 'value in to thread is bool'); + +ok(isbool(threads->create( sub { return !!0 } )->join), + 'value out of thread is bool'); + +{ + my $var = !!0; + ok(threads->create( sub { isbool($var) } )->join, + 'variable captured by thread is bool'); +} + +{ + my $sharedvar :shared = !!0; + + ok(isbool($sharedvar), + ':shared variable is bool outside'); + + ok(threads->create( sub { isbool($sharedvar) } )->join, + ':shared variable is bool inside thread'); +} diff --git a/cpan/Scalar-List-Utils/t/boolean.t b/cpan/Scalar-List-Utils/t/boolean.t new file mode 100644 index 0000000000..f543fa450c --- /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 is not supported on this perl') + : (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'); +} -- cgit v1.2.1