Bug #123901 for PDL: [PATCH] Compatibility with bitwise feature

Perl 5.22 introduced a new ‘bitwise’ experimental feature that splits the two behaviours of bitwise into two separate sets of ops, effectively giving Perl three sets of bitwise ops: bitwise-feature: &. |. etc. (string) bitwise-feature: & | etc. (number) old bitwise ops: & | etc. (string or number) To distinguish between the last two sets of ops, overload methods get a fifth true argument when the ‘bitwise’ feature is enabled. PDLs methods croak on this ‘wrong’ number of arguments. The attached patch fixes it, but after writing this patch I wondered whether it wouldn’t be better simply to wrap and2, or2 and xor in an anonymous sub for overloading, as is already done with ~. In any case, I leave it to you to do with this patch as you see fit. Please note that there were no tests at all for ^ and ~ that I could find, so I added one for each.

diff -rup PDL-2.018-KEwIyR/Basic/Gen/PP.pm PDL-2.018-0/Basic/Gen/PP.pm --- PDL-2.018-KEwIyR/Basic/Gen/PP.pm 2017-01-14 13:13:32.000000000 -0800 +++ PDL-2.018-0/Basic/Gen/PP.pm 2017-12-17 10:52:57.000000000 -0800 @@ -1860,7 +1860,7 @@ EOD # Removing useless use of hasp2child in this function. DCM Sept 12, 2011 sub VarArgsXSHdr { my($name,$xsargs,$parobjs,$optypes,#$hasp2child, - $pmcode,$hdrcode,$inplacecode,$globalnew,$callcopy) = @_; + $pmcode,$hdrcode,$inplacecode,$globalnew,$callcopy,$bitwise) = @_; # Don't do var args processing if the user has pre-defined pmcode return 'DO NOT SET!!' if ($pmcode); @@ -1977,6 +1977,9 @@ sub VarArgsXSHdr { # Add code for creating output variables via call to 'initialize' perl routine $clause3 .= callPerlInit (\@create, $ci, $callcopy); @create = (); + # Bitwise ops may get five args + my $bitwise_cond = $bitwise ? " || items == 5" : ''; + return<<END; void @@ -2009,7 +2012,7 @@ $pars $clause1 } $clause2 - else if (items == $nin) { PDL_COMMENT("only input variables on stack, create outputs and temps") + else if (items == $nin$bitwise_cond) { PDL_COMMENT("only input variables on stack, create outputs and temps") nreturn = $nallout; $clause3 } @@ -3193,7 +3196,7 @@ $PDL::PP::deftbl = # make sure it is not used when the GlobalNew flag is set ; CS 4/15/00 PDL::PP::Rule->new("VarArgsXSHdr", ["Name","NewXSArgs","USParObjs","OtherParTypes", - "PMCode","HdrCode","InplaceCode","_GlobalNew","_CallCopy"], + "PMCode","HdrCode","InplaceCode","_GlobalNew","_CallCopy","_Bitwise"], 'XS code to process arguments on stack based on supplied Pars argument to pp_def; GlobalNew has implications how/if this is done', \&VarArgsXSHdr), diff -rup PDL-2.018-KEwIyR/Basic/Ops/ops.pd PDL-2.018-0/Basic/Ops/ops.pd --- PDL-2.018-KEwIyR/Basic/Ops/ops.pd 2017-01-14 13:13:32.000000000 -0800 +++ PDL-2.018-0/Basic/Ops/ops.pd 2017-12-17 10:53:54.000000000 -0800 @@ -341,9 +341,12 @@ biop('ne','!=',1,'binary I<not equal to> my $T = [B,U,S,L,N,Q]; # the sensible types here biop('shiftleft','<<',1,'leftshift C<$a> by C<$b>',GenericTypes => $T); biop('shiftright','>>',1,'rightshift C<$a> by C<$b>',GenericTypes => $T); -biop('or2','|',1,'binary I<or> of two piddles',GenericTypes => $T); -biop('and2','&',1,'binary I<and> of two piddles',GenericTypes => $T); -biop('xor','^',1,'binary I<exclusive or> of two piddles',GenericTypes => $T); +biop('or2','|',1,'binary I<or> of two piddles',GenericTypes => $T, + Bitwise => 1); +biop('and2','&',1,'binary I<and> of two piddles',GenericTypes => $T, + Bitwise => 1); +biop('xor','^',1,'binary I<exclusive or> of two piddles',GenericTypes => $T, + Bitwise => 1); # really an ufunc ufunc('bitnot','~','unary bit negation',GenericTypes => $T); diff -rup PDL-2.018-KEwIyR/MANIFEST PDL-2.018-0/MANIFEST --- PDL-2.018-KEwIyR/MANIFEST 2017-05-21 14:18:48.000000000 -0700 +++ PDL-2.018-0/MANIFEST 2017-12-16 18:35:43.000000000 -0800 @@ -756,6 +756,7 @@ t/nsdatahandle.t t/ones.t t/op-eq-warn-for-non-numeric.t t/opengl.t +t/ops-bitwise.t t/ops.t t/pdl-from-string-bad-values.t t/pdl_from_string.t diff -rup PDL-2.018-KEwIyR/t/ops-bitwise.t PDL-2.018-0/t/ops-bitwise.t --- PDL-2.018-KEwIyR/t/ops-bitwise.t 2017-12-17 10:58:02.000000000 -0800 +++ PDL-2.018-0/t/ops-bitwise.t 2017-12-16 18:39:55.000000000 -0800 @@ -0,0 +1,21 @@ +# Run ops.t with the experimental ‘bitwise’ feature enabled. + +BEGIN { + if ("$]" < 5.022) { + print "1..0 # skip Requires Perl 5.22\n"; + exit; + } +} + +use feature 'bitwise'; + +use FindBin; +open my $fh, "$FindBin::Bin/ops.t" + or die "Cannot read $FindBin::Bin/ops.t: $!"; + +my $source = do { local $/; <$fh> }; +close $fh; + +$source =~ s/use warnings;\K/no warnings 'experimental::bitwise';/; + +eval "#line 1 opts.t_run_by_ops-bitwise.t\n$source" or die $@; diff -rup PDL-2.018-KEwIyR/t/ops.t PDL-2.018-0/t/ops.t --- PDL-2.018-KEwIyR/t/ops.t 2017-01-14 13:13:33.000000000 -0800 +++ PDL-2.018-0/t/ops.t 2017-12-17 07:17:13.000000000 -0800 @@ -1,4 +1,4 @@ -use Test::More tests => 60; +use Test::More tests => 62; use PDL::LiteF; use Config; kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging. @@ -243,3 +243,6 @@ SKIP: cmp_ok longlong(9223372036854775807) - longlong(9223372036854775806), '==', 1, "longlong precision/5"; cmp_ok longlong(9223372036854775807) + longlong(-9223372036854775808), '==',-1, "longlong precision/6"; } + +is(~pdl(1,2,3) ."", '[-2 -3 -4]', 'bitwise negation'); +is((pdl(1,2,3) ^ pdl(4,5,6))."", '[5 7 5]' , 'bitwise xor' );