Merge 5a09644 into 9b56997

MANIFEST

@@ -1977,6 +1977,8 @@ 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/boolean-thr.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
@@ -5830,6 +5832,7 @@ t/op/auto.t			See if autoincrement et all work
 t/op/avhv.t			See if pseudo-hashes work
 t/op/bless.t			See if bless works
 t/op/blocks.t			See if BEGIN and friends work
+t/op/bool.t			Check misc details of boolean values
 t/op/bop.t			See if bitops work
 t/op/caller.pl			Tests shared between caller.t and XS op.t
 t/op/caller.t			See if caller() works

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

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-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 requires XS version') :
+    (!$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');
+}

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

dump.c

@@ -1928,6 +1928,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                     PerlIO_printf(file, " [UTF8 \"%s\"]",
                                          sv_uni_display(d, sv, 6 * SvCUR(sv),
                                                         UNI_DISPLAY_QQ));
+                if (SvIsBOOL(sv))
+                    PerlIO_printf(file, " [BOOL %s]", ptr == PL_Yes ? "PL_Yes" : "PL_No");
                 PerlIO_printf(file, "\n");
             }
             Perl_dump_indent(aTHX_ level, file, "  CUR = %" IVdf "\n", (IV)SvCUR(sv));

ext/B/B.pm

@@ -20,7 +20,7 @@ sub import {
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.82';
+    $B::VERSION = '1.83';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.

ext/B/B.xs

@@ -638,7 +638,7 @@ BOOT:
     cv = newXS("B::diehook", intrpvar_sv_common, file);
     ASSIGN_COMMON_ALIAS(I, diehook);
     sv = get_sv("B::OP::does_parent", GV_ADDMULTI);
-    sv_setsv(sv, &PL_sv_yes);
+    sv_setbool(sv, TRUE);
 }
 
 void

ext/Devel-Peek/t/Peek.t

@@ -237,6 +237,30 @@ do_test('reference to scalar',
     COW_REFCNT = 1
 ');
 
+do_test('immediate boolean',
+        !!0,
+'SV = PVNV\\($ADDR\\) at $ADDR
+  REFCNT = \d+
+  FLAGS = \\(.*\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR "" \[BOOL PL_No\]
+  CUR = 0
+  LEN = 0
+') if $] >= 5.035004;
+
+do_test('assignment of boolean',
+        do { my $tmp = !!1 },
+'SV = PVNV\\($ADDR\\) at $ADDR
+  REFCNT = \d+
+  FLAGS = \\(.*\\)
+  IV = 1
+  NV = 1
+  PV = $ADDR "1" \[BOOL PL_Yes\]
+  CUR = 1
+  LEN = 0
+') if $] >= 5.035004;
+
 my $c_pattern;
 if ($type eq 'N') {
   $c_pattern = '

ext/attributes/attributes.pm

@@ -1,6 +1,6 @@
 package attributes;
 
-our $VERSION = 0.33;
+our $VERSION = 0.34;
 
 @EXPORT_OK = qw(get reftype);
 @EXPORT = ();

ext/attributes/attributes.xs

@@ -204,7 +204,7 @@ usage:
 	Perl_sv_sethek(aTHX_ TARG, HvNAME_HEK(SvSTASH(sv)));
 #if 0	/* this was probably a bad idea */
     else if (SvPADMY(sv))
-	sv_setsv(TARG, &PL_sv_no);	/* unblessed lexical */
+	sv_setbool(TARG, FALSE);	/* unblessed lexical */
 #endif
     else {
 	const HV *stash = NULL;

gv.c

@@ -3172,7 +3172,7 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
            able name. */
         if (!SvOK(right)) {
             if (ckWARN(WARN_UNINITIALIZED)) report_uninit(right);
-            sv_setsv_flags(left, &PL_sv_no, 0);
+            sv_setbool(left, FALSE);
         }
         else sv_setsv_flags(left, right, 0);
         SvGETMAGIC(right);

pp_hot.c

@@ -1083,7 +1083,7 @@ PP(pp_multiconcat)
                     if (!SvOK(right)) {
                         if (ckWARN(WARN_UNINITIALIZED))
                             report_uninit(right);
-                        sv_setsv_flags(left, &PL_sv_no, 0);
+                        sv_setbool(left, FALSE);
                     }
                     else
                         sv_setsv_flags(left, right, 0);