handle (??{}) returning an overloaded value

In this case, always pass the object to the regex compiler, which
knows how handle this.

(The diff looks more complex than it actually is: it just wraps
the whole (logical == 2) branch with an 'if (!SvAMAGIC(ret))'.)

diff --git a/lib/overload.t b/lib/overload.t
index 329b6c7..190dcf2 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -1208,11 +1208,8 @@ foreach my $op (qw(<=> == != < <= > >=)) {
         my $qr = bless qr/y/, "QRonly";
         ok("x" =~ $qr, "qr with qr-overload uses overload");
         ok("y" !~ $qr, "qr with qr-overload uses overload");
-       {
-           local $::TODO = '?? fails with "qr with qr"' ;
-           ok("x" =~ /^(??{$qr})$/, "qr with qr-overload with ?? uses overload");
-           ok("y" !~ /^(??{$qr})$/, "qr with qr-overload with ?? uses overload");
-       }
+       ok("x" =~ /^(??{$qr})$/, "qr with qr-overload with ?? uses overload");
+       ok("y" !~ /^(??{$qr})$/, "qr with qr-overload with ?? uses overload");
         is("$qr", "".qr/y/, "qr with qr-overload stringify");
 
         my $rx = $$qr;

diff --git a/regexec.c b/regexec.c
index 9c4b53d..878cdfc 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -4406,8 +4406,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 
                /* before restoring everything, evaluate the returned
                 * value, so that 'uninit' warnings don't use the wrong
-                * PL_op or pad. Also need to process any magic vars (e.g.
-                * $1 *before* parentheses are restored */
+                * PL_op or pad. Also need to process any magic vars
+                * (e.g. $1) *before* parentheses are restored */
 
                PL_op = NULL;
 
@@ -4418,22 +4418,26 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                    logical = 0;
                }
                else {                   /*  /(??{})  */
-                   SV *sv = ret;
                    re_sv = NULL;
-                   if (SvROK(sv))
-                       sv = SvRV(sv);
-                   if (SvTYPE(sv) == SVt_REGEXP)
-                       re_sv = (REGEXP*) sv;
-                   else if (SvSMAGICAL(sv)) {
-                       MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
-                       if (mg)
-                           re_sv = (REGEXP *) mg->mg_obj;
-                   }
+                   /*  if its overloaded, let the regex compiler handle
+                    *  it; otherwise extract regex, or stringify  */
+                   if (!SvAMAGIC(ret)) {
+                       SV *sv = ret;
+                       if (SvROK(sv))
+                           sv = SvRV(sv);
+                       if (SvTYPE(sv) == SVt_REGEXP)
+                           re_sv = (REGEXP*) sv;
+                       else if (SvSMAGICAL(sv)) {
+                           MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
+                           if (mg)
+                               re_sv = (REGEXP *) mg->mg_obj;
+                       }
 
-                   /* force any magic, undef warnings here */
-                   if (!re_sv && !SvAMAGIC(ret)) {
-                       ret = sv_mortalcopy(ret);
-                       (void) SvPV_force_nolen(ret);
+                       /* force any magic, undef warnings here */
+                       if (!re_sv) {
+                           ret = sv_mortalcopy(ret);
+                           (void) SvPV_force_nolen(ret);
+                       }
                    }
 
                }