From ac020e6cf2b379ba2d82ba0d931c179d56a1508e Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 27 Jan 2025 17:01:06 +0000 Subject: [PATCH] Also implement the negated versions of the flagged operators; ne:u and !=:u --- lib/B/Op_private.pm | 4 ++-- op.c | 6 ++++-- opcode.h | 12 ++++++------ pp.c | 18 ++++++++++++++++++ regen/op_private | 2 +- t/op/equ.t | 10 ++++++++++ 6 files changed, 41 insertions(+), 11 deletions(-) diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index d7f101a56f20..51f7e8cdeb31 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -123,7 +123,7 @@ our $VERSION = "5.041009"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); $bits{$_}{2} = 'OPpENTERSUB_HASTARG' for qw(ceil entersub floor goto refaddr reftype rv2cv); -$bits{$_}{7} = 'OPpEQ_UNDEF' for qw(eq seq); +$bits{$_}{7} = 'OPpEQ_UNDEF' for qw(eq ne seq sne); $bits{$_}{6} = 'OPpFLIP_LINENUM' for qw(flip flop); $bits{$_}{1} = 'OPpFT_ACCESS' for qw(fteexec fteread ftewrite ftrexec ftrread ftrwrite); $bits{$_}{4} = 'OPpFT_AFTER_t' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero); @@ -891,7 +891,7 @@ our %ops_using = ( OPpENTERSUB_HASTARG => [qw(ceil entersub floor goto refaddr reftype rv2cv)], OPpENTERSUB_INARGS => [qw(entersub)], OPpENTERSUB_NOPAREN => [qw(rv2cv)], - OPpEQ_UNDEF => [qw(eq seq)], + OPpEQ_UNDEF => [qw(eq ne seq sne)], OPpEVAL_BYTES => [qw(entereval)], OPpEXISTS_SUB => [qw(exists)], OPpFLIP_LINENUM => [qw(flip flop)], diff --git a/op.c b/op.c index 1549303c5252..1e05a0050585 100644 --- a/op.c +++ b/op.c @@ -16200,8 +16200,10 @@ Perl_apply_opflags(pTHX_ U32 opcode, char *flagstr) for(char flag; (flag = *flagstr); flagstr++) { switch(opcode_base) { - case OP_SEQ: - case OP_EQ: + case OP_SEQ: /* eq */ + case OP_SNE: /* ne */ + case OP_EQ: /* == */ + case OP_NE: /* != */ switch(flag) { case 'u': priv |= OPpEQ_UNDEF; diff --git a/opcode.h b/opcode.h index ac7d9641deb8..3d824da9a47e 100644 --- a/opcode.h +++ b/opcode.h @@ -2652,7 +2652,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 13, /* i_ge */ 105, /* eq */ 13, /* i_eq */ - 13, /* ne */ + 105, /* ne */ 13, /* i_ne */ 13, /* ncmp */ 13, /* i_ncmp */ @@ -2661,7 +2661,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 13, /* sle */ 13, /* sge */ 105, /* seq */ - 13, /* sne */ + 105, /* sne */ 13, /* scmp */ 107, /* bit_and */ 107, /* bit_xor */ @@ -3013,7 +3013,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x077e, 0x0554, 0x1b70, 0x542c, 0x4fc8, 0x4225, /* const */ 0x3cfc, 0x47f9, /* gvsv */ 0x19d5, /* gv */ - 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, sne, scmp, lslice, xor, isa */ + 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, i_eq, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, scmp, lslice, xor, isa */ 0x3cfc, 0x5378, 0x04f7, /* padsv */ 0x3cfc, 0x5378, 0x0003, /* padsv_store, lvavref */ 0x3cfc, 0x5378, 0x06d4, 0x3dec, 0x5149, /* padav */ @@ -3038,7 +3038,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x3cfc, 0x0338, 0x1e34, 0x57d0, 0x550c, 0x0003, /* multiconcat */ 0x57d0, 0x02af, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ 0x57d0, 0x5b69, /* left_shift, right_shift, nbit_and, nbit_xor, nbit_or, ncomplement */ - 0x5a3c, 0x0067, /* eq, seq */ + 0x5a3c, 0x0067, /* eq, ne, seq, sne */ 0x5b69, /* bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, complement */ 0x06d4, 0x57d0, 0x0003, /* length */ 0x4d30, 0x3dec, 0x024b, /* substr */ @@ -3181,7 +3181,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* I_GE */ (OPpARG2_MASK), /* EQ */ (OPpARG2_MASK|OPpEQ_UNDEF), /* I_EQ */ (OPpARG2_MASK), - /* NE */ (OPpARG2_MASK), + /* NE */ (OPpARG2_MASK|OPpEQ_UNDEF), /* I_NE */ (OPpARG2_MASK), /* NCMP */ (OPpARG2_MASK), /* I_NCMP */ (OPpARG2_MASK), @@ -3190,7 +3190,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* SLE */ (OPpARG2_MASK), /* SGE */ (OPpARG2_MASK), /* SEQ */ (OPpARG2_MASK|OPpEQ_UNDEF), - /* SNE */ (OPpARG2_MASK), + /* SNE */ (OPpARG2_MASK|OPpEQ_UNDEF), /* SCMP */ (OPpARG2_MASK), /* BIT_AND */ (OPpUSEINT), /* BIT_XOR */ (OPpUSEINT), diff --git a/pp.c b/pp.c index 30fab5edb123..e61eeb1f3b43 100644 --- a/pp.c +++ b/pp.c @@ -2290,6 +2290,15 @@ PP(pp_ne) SV *right = PL_stack_sp[0]; SV *left = PL_stack_sp[-1]; + if(UNLIKELY(PL_op->op_private & OPpEQ_UNDEF)) { + bool lundef = !SvOK(left), rundef = !SvOK(right); + + if(lundef || rundef) { + rpp_replace_2_IMM_NN(boolSV(!(lundef && rundef))); + return NORMAL; + } + } + U32 flags_and = SvFLAGS(left) & SvFLAGS(right); U32 flags_or = SvFLAGS(left) | SvFLAGS(right); @@ -2473,6 +2482,15 @@ PP(pp_sne) SV *right = PL_stack_sp[0]; SV *left = PL_stack_sp[-1]; + if(PL_op->op_private & OPpEQ_UNDEF) { + bool lundef = !SvOK(left), rundef = !SvOK(right); + + if(lundef || rundef) { + rpp_replace_2_IMM_NN(boolSV(!(lundef && rundef))); + return NORMAL; + } + } + rpp_replace_2_IMM_NN(boolSV(!sv_eq_flags(left, right, 0))); return NORMAL; } diff --git a/regen/op_private b/regen/op_private index 086fbe783198..ca145d3e9891 100644 --- a/regen/op_private +++ b/regen/op_private @@ -922,7 +922,7 @@ addbits('emptyavhv', addbits($_, 7 => qw(OPpEQ_UNDEF UNDEF), -) for qw( eq seq ); +) for qw( eq ne seq sne ); addbits('argdefelem', 7 => qw(OPpARG_IF_UNDEF IF_UNDEF), diff --git a/t/op/equ.t b/t/op/equ.t index c5b61f750b6c..eb7f1145d44c 100644 --- a/t/op/equ.t +++ b/t/op/equ.t @@ -60,6 +60,11 @@ ok(not(123 ==:u 456), '==:u on different values'); is($warnings, 0, 'no warnings were produced by use of undef'); } +foreach (["abc", "abc"], ["abc", "def"], ["", undef], [undef, undef]) { + my ($left, $right) = @$_; + is(not($left ne:u $right), ($left eq:u $right), 'ne:u is a synonym for not(eq:u)'); +} + # ==:u treats undef as distinct, equal to itself, with no warnings { my $warnings = 0; @@ -71,6 +76,11 @@ ok(not(123 ==:u 456), '==:u on different values'); is($warnings, 0, 'no warnings were produced by use of undef'); } +foreach ([123, 123], [123, 456], [0, undef], [undef, undef]) { + my ($left, $right) = @$_; + is(not($left !=:u $right), ($left ==:u $right), '!=:u is a synonym for not(==:u)'); +} + # performs GETMAGIC { "abc" =~ m/(\d+)/;