make m?$pat? match only once under ithreads

[perl #115080]

m?...? is only supposed to match once, until reset. Normally this is done
by setting the PMf_USED flag on the PMOP. Under ithreads we can't modify
ops, so instead we indicate by setting the regex's SV to readonly. (This
is a bit of a hack: the flag should be associated with the PMOP, not the
regex).

This breaks with run-time regexes when the pattern gets recompiled; for
example:

    for my $c (qw(a b c)) {
	print "matched $c\n" if $c =~ m?^$c$?;
    }

outputs

    matched a

on unthreaded, but

    matched a
    matched b
    matched c

on threaded.

The re_eval jumbo fix made this more noticeable by sometimes recompiling
even when the pattern text hasn't changed (to make closures work ok).

The quick fix is to propagate the readonlyness of the old re to the new
re. (The proper fix would be to store the flag state in a pad slot
associated with the PMOP).
Needless to say, I've gone for the quick fix.

diff --git a/op.h b/op.h
index 286b880..88703da 100644 (file)
--- a/op.h
+++ b/op.h
@@ -412,7 +412,7 @@ struct pmop {
  * OP_MATCH and OP_QR */
 #define PMf_ONCE       (1<<(PMf_BASE_SHIFT+1))
 
-/* PMf_ONCE has matched successfully.  Not used under threading. */
+/* PMf_ONCE, i.e. ?pat?, has matched successfully.  Not used under threading. */
 #define PMf_USED        (1<<(PMf_BASE_SHIFT+3))
 
 /* subst replacement is constant */

diff --git a/regcomp.c b/regcomp.c
index d2535f0..2e1ed42 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6350,6 +6350,14 @@ reStudy:
         PerlIO_printf(Perl_debug_log, "\n");
     });
 #endif
+
+#ifdef USE_ITHREADS
+    /* under ithreads the ?pat? PMf_USED flag on the pmop is simulated
+     * by setting the regexp SV to readonly-only instead. If the
+     * pattern's been recompiled, the USEDness should remain. */
+    if (old_re && SvREADONLY(old_re))
+        SvREADONLY_on(rx);
+#endif
     return rx;
 }
 

diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index ddc53f7..061e7e5 100644 (file)
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 }
 
 
-plan tests => 459;  # Update this when adding/deleting tests.
+plan tests => 463;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1004,7 +1004,42 @@ sub run_tests {
        }
     }
 
+    #  [perl #115080]
+    #  Ensure that ?pat? matches exactly once, even when the run-time
+    #  pattern changes, and even when the presence of run-time (?{}) affects
+    #  how and when patterns are recompiled
 
+    {
+       my $m;
+
+       $m = '';
+       for (qw(a a a)) {
+           $m .= $_ if m?$_?;
+       }
+       is($m, 'a', '?pat? with a,a,a');
+
+       $m = '';
+       for (qw(a b c)) {
+           $m .= $_ if m?$_?;
+       }
+       is($m, 'a', '?pat? with a,b,c');
+
+       use re 'eval';
+
+       $m = '';
+       for (qw(a a a)) {
+       my $e = qq[(??{"$_"})];
+           $m .= $_ if m?$e?;
+       }
+       is($m, 'a', '?pat? with (??{a,a,a})');
+
+       $m = '';
+       for (qw(a b c)) {
+       my $e = qq[(??{"$_"})];
+           $m .= $_ if m?$e?;
+       }
+       is($m, 'a', '?pat? with (??{a,b,c})');
+    }
 
 
 } # End of sub run_tests