5th arg to indicate numeric bitwise overloading

diff --git a/gv.c b/gv.c
index 236416a..82db197 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2842,7 +2842,9 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
     SvGETMAGIC(arg);
 
     if (SvAMAGIC(arg) && (tmpsv = amagic_call(arg, &PL_sv_undef, method,
-                                             AMGf_noright | AMGf_unary))) {
+                                             AMGf_noright | AMGf_unary
+                                           | (flags & AMGf_numarg))))
+    {
        if (flags & AMGf_set) {
            SETs(tmpsv);
        }
@@ -2887,7 +2889,8 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
 
     if (SvAMAGIC(left) || SvAMAGIC(right)) {
        SV * const tmpsv = amagic_call(left, right, method,
-                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0));
+                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0)
+                 | (flags & AMGf_numarg));
        if (tmpsv) {
            if (flags & AMGf_set) {
                (void)POPs;
@@ -3395,6 +3398,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       PUSHs(newSVpvn_flags(AMG_id2name(method + assignshift),
                           AMG_id2namelen(method + assignshift), SVs_TEMP));
     }
+    else if (flags & AMGf_numarg)
+      PUSHs(&PL_sv_undef);
+    if (flags & AMGf_numarg)
+      PUSHs(&PL_sv_yes);
     PUSHs(MUTABLE_SV(cv));
     PUTBACK;
     oldmark = TOPMARK;

diff --git a/lib/overload.t b/lib/overload.t
index 9e9798c..6bbbb0b 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5200;
+plan tests => 5215;
 
 use Scalar::Util qw(tainted);
 
@@ -2759,7 +2759,11 @@ package bitops {
     use overload do {
        my %o;
        for my $o (qw(& | ^ ~ &. |. ^. ~. &= |= ^= &.= |.= ^.=)) {
-           $o{$o} = sub { push @o, $o; $_[0] }
+           $o{$o} = sub {
+               ::ok !defined $_[3], "undef (or nonexistent) arg 3 for $o";
+               push @o, $o, scalar @_, $_[4]//'u';
+               $_[0]
+           }
        }
        %o, '=' => sub { bless [] };
     }
@@ -2781,9 +2785,37 @@ package bitops {
     $o &.= 0;
     $o |.= 0;
     $o ^.= 0;
-    is "@bitops::o", '& | ^ ~ &. |. ^. ~. &= |= ^= &.= |.= ^.=',
+    # elems are in triplets: op, length of @_, numeric? (1/u for y/n)
+    is "@bitops::o", '& 5 1 | 5 1 ^ 5 1 ~ 5 1 &. 3 u |. 3 u ^. 3 u ~. 3 u '               . '&= 5 1 |= 5 1 ^= 5 1 &.= 3 u |.= 3 u ^.= 3 u',
        'experimental "bitwise" ops'
 }
+package bitops2 {
+    our @o;
+    use overload
+        nomethod => sub { push @o, $_[3], scalar @_, $_[4]//'u'; $_[0] },
+       '=' => sub { bless [] };
+}
+{
+    use experimental 'bitwise';
+    my $o = bless [], bitops2::;
+    $_ = $o & 0;
+    $_ = $o | 0;
+    $_ = $o ^ 0;
+    $_ = ~$o;
+    $_ = $o &. 0;
+    $_ = $o |. 0;
+    $_ = $o ^. 0;
+    $_ = ~.$o;
+    $o &= 0;
+    $o |= 0;
+    $o ^= 0;
+    $o &.= 0;
+    $o |.= 0;
+    $o ^.= 0;
+    # elems are in triplets: op, length of @_, numeric? (1/u for y/n)
+    is "@bitops2::o", '& 5 1 | 5 1 ^ 5 1 ~ 5 1 &. 4 u |. 4 u ^. 4 u ~. 4 u '               . '&= 5 1 |= 5 1 ^= 5 1 &.= 4 u |.= 4 u ^.= 4 u',
+       'experimental "bitwise" ops with nomethod'
+}
 
 { # undefining the overload stash -- KEEP THIS TEST LAST
     package ant;

diff --git a/pp.c b/pp.c
index 2cd2d5e..c9d9e1a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2227,7 +2227,7 @@ PP(pp_bit_and)
 PP(pp_nbit_and)
 {
     dSP;
-    tryAMAGICbin_MG(band_amg, AMGf_assign);
+    tryAMAGICbin_MG(band_amg, AMGf_assign|AMGf_numarg);
     {
        dATARGET; dPOPTOPssrl;
        if (PL_op->op_private & HINT_INTEGER) {
@@ -2297,7 +2297,7 @@ PP(pp_nbit_or)
     const int op_type = PL_op->op_type;
 
     tryAMAGICbin_MG((op_type == OP_NBIT_OR ? bor_amg : bxor_amg),
-                   AMGf_assign);
+                   AMGf_assign|AMGf_numarg);
     {
        dATARGET; dPOPTOPssrl;
        if (PL_op->op_private & HINT_INTEGER) {
@@ -2515,7 +2515,7 @@ PP(pp_complement)
 PP(pp_ncomplement)
 {
     dSP;
-    tryAMAGICun_MG(compl_amg, AMGf_numeric);
+    tryAMAGICun_MG(compl_amg, AMGf_numeric|AMGf_numarg);
     {
        dTARGET; dTOPss;
        if (PL_op->op_private & HINT_INTEGER) {

diff --git a/pp.h b/pp.h
index c417c1e..2636dbf 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -405,6 +405,7 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 #define AMGf_numeric   0x10    /* for Perl_try_amagic_bin */
 #define AMGf_set       0x20    /* for Perl_try_amagic_bin */
 #define AMGf_want_list 0x40
+#define AMGf_numarg    0x80
 
 
 /* do SvGETMAGIC on the stack args before checking for overload */