OP *o = NULL;
int n = 0;
bool utf8 = 0;
+ STRLEN orig_patlen = 0;
if (pRExC_state->num_code_blocks) {
o = cLISTOPx(expr)->op_first;
o = o->op_sibling;;
}
+ if ((SvAMAGIC(pat) || SvAMAGIC(msv)) &&
+ (sv = amagic_call(pat, msv, concat_amg, AMGf_assign)))
+ {
+ sv_setsv(pat, sv);
+ /* overloading involved: all bets are off over literal
+ * code. Pretend we haven't seen it */
+ pRExC_state->num_code_blocks -= n;
+ n = 0;
+ rx = NULL;
+
+ }
+ else {
+ while (SvAMAGIC(msv)
+ && (sv = AMG_CALLunary(msv, string_amg))
+ && sv != msv)
+ {
+ msv = sv;
+ SvGETMAGIC(msv);
+ }
+ if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP)
+ msv = SvRV(msv);
+ orig_patlen = SvCUR(pat);
+ sv_catsv_nomg(pat, msv);
+ rx = msv;
+ if (code)
+ pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;
+ }
+
/* extract any code blocks within any embedded qr//'s */
- rx = msv;
- if (SvROK(rx))
- rx = SvRV(rx);
- if (SvTYPE(rx) == SVt_REGEXP
+ if (rx && SvTYPE(rx) == SVt_REGEXP
&& RX_ENGINE((REGEXP*)rx)->op_comp)
{
pRExC_state->num_code_blocks += ri->num_code_blocks;
for (i=0; i < ri->num_code_blocks; i++) {
struct reg_code_block *src, *dst;
- STRLEN offset = SvCUR(pat)
+ STRLEN offset = orig_patlen
+ ((struct regexp *)SvANY(rx))->pre_prefix;
assert(n < pRExC_state->num_code_blocks);
src = &ri->code_blocks[i];
}
}
}
-
- if ((SvAMAGIC(pat) || SvAMAGIC(msv)) &&
- (sv = amagic_call(pat, msv, concat_amg, AMGf_assign)))
- {
- sv_setsv(pat, sv);
- /* overloading involved: all bets are off over literal
- * code. Pretend we haven't seen it */
- pRExC_state->num_code_blocks -= n;
- n = 0;
-
- }
- else {
- if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP)
- msv = SvRV(msv);
- sv_catsv_nomg(pat, msv);
- if (code)
- pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;
- }
}
SvSETMAGIC(pat);
}
- else
+ else {
+ SV *sv;
pat = *patternp;
+ while (SvAMAGIC(pat)
+ && (sv = AMG_CALLunary(pat, string_amg))
+ && sv != pat)
+ {
+ pat = sv;
+ SvGETMAGIC(pat);
+ }
+ }
/* handle bare regex: foo =~ $re */
{
require './test.pl';
}
-plan tests => 438; # Update this when adding/deleting tests.
+plan tests => 452; # Update this when adding/deleting tests.
run_tests() unless caller;
}
}
+ # #113682 more overloading and qr//
+ # when doing /foo$overloaded/, if $overloaded returns
+ # a qr/(?{})/ via qr or "" overloading, then 'use re 'eval'
+ # shouldn't be required. Via '.', it still is.
+ {
+ package Qr0;
+ use overload 'qr' => sub { qr/(??{50})/ };
+
+ package Qr1;
+ use overload '""' => sub { qr/(??{51})/ };
+
+ package Qr2;
+ use overload '.' => sub { $_[1] . qr/(??{52})/ };
+
+ package Qr3;
+ use overload '""' => sub { qr/(??{7})/ },
+ '.' => sub { $_[1] . qr/(??{53})/ };
+
+ package Qr_indirect;
+ use overload '""' => sub { $_[0][0] };
+
+ package main;
+
+ for my $i (0..3) {
+ my $o = bless [], "Qr$i";
+ if ((0,0,1,1)[$i]) {
+ eval { "A5$i" =~ /^A$o$/ };
+ like($@, qr/Eval-group not allowed/, "Qr$i");
+ eval { "5$i" =~ /$o/ };
+ like($@, ($i == 3 ? qr/^$/ : qr/no method found,/),
+ "Qr$i bare");
+ {
+ use re 'eval';
+ ok("A5$i" =~ /^A$o$/, "Qr$i - with use re eval");
+ eval { "5$i" =~ /$o/ };
+ like($@, ($i == 3 ? qr/^$/ : qr/no method found,/),
+ "Qr$i bare - with use re eval");
+ }
+ }
+ else {
+ ok("A5$i" =~ /^A$o$/, "Qr$i");
+ ok("5$i" =~ /$o/, "Qr$i bare");
+ }
+ }
+
+ my $o = bless [ bless [], "Qr1" ], 'Qr_indirect';
+ ok("A51" =~ /^A$o/, "Qr_indirect");
+ ok("51" =~ /$o/, "Qr_indirect bare");
+ }
+
} # End of sub run_tests
1;