diff options
| -rw-r--r-- | lib/overload.t | 5 | ||||
| -rw-r--r-- | pp_ctl.c | 16 |
2 files changed, 15 insertions, 6 deletions
diff --git a/lib/overload.t b/lib/overload.t index 7d4dbff315..d59c33daf7 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -1798,10 +1798,7 @@ foreach my $op (qw(<=> == != < <= > >=)) { # note: this is testing unary qr, not binary =~ $subs{qr} = '(qr/%s/)'; - # XXX TODO qr overload with fallback calls "" and FETCH too often - #push @tests, [ "abc", '"abc" =~ (%s)', '(qr)', '("")', [ 1, 2, 0 ], 0 ]; - push @tests, [ "abc", '"abc" =~ (%s)', '(qr)', '("")("")', - [ 1, 2, 0, 1, 5, 0 ], 0 ]; + push @tests, [ "abc", '"abc" =~ (%s)', '(qr)', '("")', [ 1, 2, 0 ], 0 ]; $e = '"abc" ~~ (%s)'; $subs{'~~'} = $e; @@ -176,8 +176,9 @@ PP(pp_regcomp) PM_SETRE(pm, re); } else { - STRLEN len; - const char *t = SvOK(tmpstr) ? SvPV_const(tmpstr, len) : ""; + STRLEN len = 0; + const char *t = SvOK(tmpstr) ? SvPV_nomg_const(tmpstr, len) : ""; + re = PM_GETRE(pm); assert (re != (REGEXP*) &PL_sv_undef); @@ -215,6 +216,17 @@ PP(pp_regcomp) const char *const p = SvPV(tmpstr, len); tmpstr = newSVpvn_flags(p, len, SVs_TEMP); } + else if (SvAMAGIC(tmpstr)) { + /* make a copy to avoid extra stringifies */ + SV* copy = newSV_type(SVt_PV); + sv_setpvn(copy, t, len); + if (SvUTF8(tmpstr)) + SvUTF8_on(copy); + else + SvUTF8_off(copy); + sv_2mortal(copy); + tmpstr = copy; + } if (eng) PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags)); |