Add B helpers to check if the Sv is a boolean

Bool are using PVNV. It makes it more convenient
to provide these helpers at the top level for any SVs.

So we can easily check if the SV is a boolean and check
if it's true or false.

3 files changed, 113 insertions, 4 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 9e6f2897c8..baf06acbd1 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -20,7 +20,7 @@ sub import {
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.83';
+    $B::VERSION = '1.84';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -593,6 +593,26 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =item FLAGS
 
+=item IsBOOL
+
+Returns true if the SV is a boolean (true or false).
+You can then use C<TRUE> to check if the value is true or false.
+
+    my $something = ( 1 == 1 ) # boolean true
+                 || ( 1 == 0 ) # boolean false
+                 || 42         # IV true
+                 || 0;         # IV false
+    my $sv = B::svref_2object(\$something);
+
+    say q[Not a boolean value]
+        if ! $sv->IsBOOL;
+
+    say q[This is a boolean with value: true]
+        if   $sv->IsBOOL && $sv->TRUE_nomg;
+
+    say q[This is a boolean with value: false]
+        if   $sv->IsBOOL && ! $sv->TRUE_nomg;
+
 =item object_2svref
 
 Returns a reference to the regular scalar corresponding to this
@@ -601,6 +621,24 @@ to the svref_2object() subroutine.  This scalar and other data it points
 at should be considered read-only: modifying them is neither safe nor
 guaranteed to have a sensible effect.
 
+=item TRUE
+
+Returns a boolean indicating hether Perl would evaluate the SV as true or
+false.
+
+B<Warning> this call performs 'get' magic. If you only want to check the
+nature of this SV use C<TRUE_nomg> helper.
+
+This is an alias for C<SvTRUE($sv)>.
+
+=item TRUE_nomg
+
+Check if the value is true (do not perform 'get' magic).
+Returns a boolean indicating whether Perl would evaluate the SV as true or
+false.
+
+This is an alias for C<SvTRUE_nomg($sv)>.
+
 =back
 
 =head2 B::IV Methods
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 7cdd0f9c6a..b786f0fb0b 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1398,12 +1398,12 @@ aux_list(o, cv)
 
 
 
-MODULE = B	PACKAGE = B::SV
+MODULE = B	PACKAGE = B::SV         PREFIX = Sv
 
 #define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
 
 U32
-REFCNT(sv)
+SvREFCNT(sv)
 	B::SV	sv
     ALIAS:
 	FLAGS = 0xFFFFFFFF
@@ -1417,11 +1417,23 @@ REFCNT(sv)
 	RETVAL
 
 void
-object_2svref(sv)
+Svobject_2svref(sv)
 	B::SV	sv
     PPCODE:
 	ST(0) = sv_2mortal(newRV(sv));
 	XSRETURN(1);
+
+bool
+SvIsBOOL(sv)
+    B::SV   sv
+
+bool
+SvTRUE(sv)
+    B::SV   sv
+
+bool
+SvTRUE_nomg(sv)
+    B::SV   sv
 	
 MODULE = B	PACKAGE = B::IV		PREFIX = Sv
 
diff --git a/ext/B/t/bool.t b/ext/B/t/bool.t
new file mode 100644
index 0000000000..1af7dfbab0
--- /dev/null
+++ b/ext/B/t/bool.t
@@ -0,0 +1,59 @@
+#!./perl
+
+BEGIN {
+    unshift @INC, 't';
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+}
+
+use strict;
+use warnings;
+
+use B;
+use Test::More;
+
+$|  = 1;
+
+{
+    note "testing true";
+    my $bool = ( 1 == 1 );
+    my $sv = B::svref_2object(\$bool);
+    ok $sv->IsBOOL, "got a boolean";
+    ok $sv->TRUE_nomg, "TRUE_nomg is true";
+    ok $sv->TRUE, "TRUE is true";
+}
+
+{
+    note "testing false";
+    my $bool = ( 1 == 0 );
+    my $sv = B::svref_2object(\$bool);
+
+    ok $sv->IsBOOL, "got a boolean";
+    ok !$sv->TRUE_nomg, "TRUE_nomg is false";
+    ok !$sv->TRUE, "TRUE is false";
+}
+
+{
+    note "not a boolean";
+    my $iv = 42;
+    my $sv = B::svref_2object(\$iv);
+
+    ok !$sv->IsBOOL, "not a boolean";
+    ok $sv->TRUE_nomg, "TRUE_nomg is true";
+    ok $sv->TRUE, "TRUE is true";
+}
+
+{
+    note "not a boolean";
+    my $iv = 0;
+    my $sv = B::svref_2object(\$iv);
+
+    ok !$sv->IsBOOL, "not a boolean";
+    ok !$sv->TRUE_nomg, "TRUE_nomg is false";
+    ok !$sv->TRUE, "TRUE is false";
+}
+
+done_testing();