fix SvTRUE() cast (broke xor)

RT #131820

It turns out that the 'xor' operator is almost completely untested in
core. A recent change of mine to the SvTRUE() macros made it sometimes
return an int (SvIVX(sv)) rather than a boolean (SvIVX(sv)!=0), while its
documented to return a boolean.

pp_xor() tests for (SvTRUE(left) != SvTRUE(right)) which subsequently
broke, e.g. (1 xor 5) started returning true rather than false.

Fix SvTRUE() and add some basic xor tests.

diff --git a/sv.h b/sv.h
index ad7046a..198d1d1 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1775,7 +1775,7 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
     : SvPOK(sv)                                                \
        ? SvPVXtrue(sv)                                 \
     : SvIOK(sv)                                                \
-        ? SvIVX(sv)                                     \
+        ? (SvIVX(sv) != 0)                              \
     : (SvROK(sv) && !(   SvOBJECT(SvRV(sv))             \
                       && HvAMAGIC(SvSTASH(SvRV(sv)))))  \
         ? TRUE                                          \

diff --git a/t/op/lop.t b/t/op/lop.t
index 9ec628a..2f1ad20 100644 (file)
--- a/t/op/lop.t
+++ b/t/op/lop.t
@@ -1,7 +1,7 @@
 #!./perl
 
 #
-# test the logical operators '&&', '||', '!', 'and', 'or', 'not'
+# test the logical operators '&&', '||', '!', 'and', 'or', , 'xor', 'not'
 #
 
 BEGIN {
@@ -10,7 +10,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan tests => 23;
+plan tests => 33;
 
 for my $i (undef, 0 .. 2, "", "0 but true") {
     my $true = 1;
@@ -82,3 +82,26 @@ is( $i, 11, 'negation precedence with &&, multiple operands' );
     $i = !do { "str" } && !$x;
     is( $i, '', 'neg-do-const on lhs of && with non-foldable neg-true on rhs' );
 }
+
+# RT #131820
+#
+# It turns out that in 2017, 23 years after the release of perl5,
+# the 'xor' logical operator was still untested in core.
+
+for my $test (
+    [ 0, 0, '' ],
+    [ 0, 1, 1  ],
+    [ 1, 0, 1  ],
+    [ 1, 1, '' ],
+
+    [ 0, 2, 1  ],
+    [ 2, 0, 1  ],
+    [ 2, 2, '' ],
+
+    [ 0, 3, 1  ],
+    [ 3, 0, 1  ],
+    [ 3, 4, '' ],
+) {
+    my ($a,$b, $exp) = @$test;
+    is(($a xor $b), $exp, "($a xor $b) == '$exp'");
+}