Add a Scalar::Util::isbool()

Remember to SvGETMAGIC() before testing SvIsBOOL() (thanks @tonycoz)

MANIFEST

@@ -1973,6 +1973,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

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

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;
 

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;

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<NOTE>: Copying a weak reference creates a normal, strong, reference.
 
 =head1 OTHER FUNCTIONS
 
+=head2 isbool
+
+    my $bool = isbool( $var );
+
+I<Available only since perl 5.35.3 onwards.>
+
+Returns true if the given variable is boolean in nature - that is, it is the
+result of a boolean operator (such as C<defined>, C<exists>, or a numerical or
+string comparison), or is a variable that is copied from one.
+
 =head2 dualvar
 
     my $var = dualvar( $num, $string );

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

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');
+}