This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Relax fatal circumstances of unescaped '{'
authorKarl Williamson <khw@cpan.org>
Wed, 31 May 2017 03:19:20 +0000 (21:19 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 1 Jun 2017 13:05:16 +0000 (07:05 -0600)
After the 5.26.0 code freeze, it came out that an application that many
others depend on, GNU Autoconf, has an unescaped '{' in it.  Commit
7335cb814c19345052a23bc4462c701ce734e6c5 created a kludge that was
minimal, and designed to get just that one application to work.

I originally proposed a less kludgy patch that was applicable across a
larger set of applications.  The proposed patch didn't fatalize uses
of unesacped '{' where we don't anticipate using it for something other
than its literal self.  That approach worked for Autoconf, but also far
more instances, but was more complicated, and was rejected as being too
risky during code freeze.

Now this commit implements my original suggestion.  I am putting it in
now, to let it soak in blead, in case something else surfaces besides
Autoconf, that we need to work around.  By having experience with the
patch live, we can be more confident about using it, if necessary, in a
dot release.

embed.fnc
embed.h
pod/perldelta.pod
proto.h
regcomp.c
t/re/reg_mesg.t

index 226b196..bb107fa 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1655,6 +1655,7 @@ EMRs      |SV*    |_make_exactf_invlist   |NN RExC_state_t *pRExC_state \
                                        |NN regnode *node
 EsMR   |SV*    |invlist_contents|NN SV* const invlist              \
                                 |const bool traditional_style
+EsRn   |bool   |new_regcurly   |NN const char *s|NN const char *e
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
 EXmM   |void   |_invlist_intersection  |NN SV* const a|NN SV* const b|NN SV** i
diff --git a/embed.h b/embed.h
index 2fa77c6..54b8fbd 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define is_ssc_worth_it                S_is_ssc_worth_it
 #define join_exact(a,b,c,d,e,f,g)      S_join_exact(aTHX_ a,b,c,d,e,f,g)
 #define make_trie(a,b,c,d,e,f,g,h)     S_make_trie(aTHX_ a,b,c,d,e,f,g,h)
+#define new_regcurly           S_new_regcurly
 #define nextchar(a)            S_nextchar(aTHX_ a)
 #define output_or_return_posix_warnings(a,b,c) S_output_or_return_posix_warnings(aTHX_ a,b,c)
 #define parse_lparen_question_flags(a) S_parse_lparen_question_flags(aTHX_ a)
index 13b9cdc..584474d 100644 (file)
@@ -59,6 +59,23 @@ respectively.
 
 XXX Any deprecated features, syntax, modules etc. should be listed here.
 
+=head2 Some uses of unescaped C<"{"> are no longer fatal
+
+Perl 5.26.0 fatalized some uses of an unescaped left brace, but an
+exception was made at the last minute, specifically crafted to be a
+minimal change to allow GNU Autoconf to work.  This code is heavily
+depended upon, and continues to use the deprecated usage.  Its use of an
+unescaped left brace is one where we have no intention of repurposing
+C<"{"> to be something other than itself.
+
+That exception is now generalized to include various other such cases
+where the C<"{"> will not be repurposed.  This is to get real experience
+with this more complicated change now, in case we need to issue a dot
+release if we find other things like Autoconf that are important to work
+around.
+
+Note that these uses continue to raise a deprecation message.
+
 =head2 Module removals
 
 XXX Remove this section if inapplicable.
diff --git a/proto.h b/proto.h
index 367352c..f605643 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5138,6 +5138,11 @@ STATIC U32       S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, UV *min_
 STATIC I32     S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth);
 #define PERL_ARGS_ASSERT_MAKE_TRIE     \
        assert(pRExC_state); assert(startbranch); assert(first); assert(last); assert(tail)
+STATIC bool    S_new_regcurly(const char *s, const char *e)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_NEW_REGCURLY  \
+       assert(s); assert(e)
+
 STATIC void    S_nextchar(pTHX_ RExC_state_t *pRExC_state);
 #define PERL_ARGS_ASSERT_NEXTCHAR      \
        assert(pRExC_state)
index b0a279e..6fc3716 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -12398,6 +12398,52 @@ S_alloc_maybe_populate_EXACT(pTHX_ RExC_state_t *pRExC_state,
     }
 }
 
+STATIC bool
+S_new_regcurly(const char *s, const char *e)
+{
+    /* This is a temporary function designed to match the most lenient form of
+     * a {m,n} quantifier we ever envision, with either number omitted, and
+     * spaces anywhere between/before/after them.
+     *
+     * If this function fails, then the string it matches is very unlikely to
+     * ever be considered a valid quantifier, so we can allow the '{' that
+     * begins it to be considered as a literal */
+
+    bool has_min = FALSE;
+    bool has_max = FALSE;
+
+    PERL_ARGS_ASSERT_NEW_REGCURLY;
+
+    if (s >= e || *s++ != '{')
+       return FALSE;
+
+    while (s < e && isSPACE(*s)) {
+        s++;
+    }
+    while (s < e && isDIGIT(*s)) {
+        has_min = TRUE;
+        s++;
+    }
+    while (s < e && isSPACE(*s)) {
+        s++;
+    }
+
+    if (*s == ',') {
+       s++;
+        while (s < e && isSPACE(*s)) {
+            s++;
+        }
+        while (s < e && isDIGIT(*s)) {
+            has_max = TRUE;
+            s++;
+        }
+        while (s < e && isSPACE(*s)) {
+            s++;
+        }
+    }
+
+    return s < e && *s == '}' && (has_min || has_max);
+}
 
 /* Parse backref decimal value, unless it's too big to sensibly be a backref,
  * in which case return I32_MAX (rather than possibly 32-bit wrapping) */
@@ -12832,6 +12878,12 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
             /* FALLTHROUGH */
 
           finish_meta_pat:
+            if (   UCHARAT(RExC_parse + 1) == '{'
+                && UNLIKELY(! new_regcurly(RExC_parse + 1, RExC_end)))
+            {
+                RExC_parse += 2;
+                vFAIL("Unescaped left brace in regex is illegal here");
+            }
            nextchar(pRExC_state);
             Set_Node_Length(ret, 2); /* MJD */
            break;
@@ -13381,22 +13433,25 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
                    } /* End of switch on '\' */
                    break;
                case '{':
-                   /* Currently we don't care if the lbrace is at the start
-                    * of a construct.  This catches it in the middle of a
-                    * literal string, or when it's the first thing after
-                    * something like "\b" */
-                   if (len || (p > RExC_start && isALPHA_A(*(p -1)))) {
-
-                        /* GNU Autoconf is depended on by a lot of code, and
-                         * can't seem to release a new version that avoids the
-                         * deprecation now made fatal.  (A commit to do so has
-                         * been in its repository since early 2013; only one
-                         * pattern is affected.)  As a work-around, don't
-                         * fatalize this if the pattern being compiled is the
-                         * precise one that trips up Autoconf.  See [perl
-                         * #130497] for more details. */
-                        if (memNEs(RExC_start, RExC_end - RExC_start,
-                                   "\\${[^\\}]*}"))
+                    /* Currently we allow an lbrace at the start of a construct
+                     * without raising a warning.  This is because we think we
+                     * will never want such a brace to be meant to be other
+                     * than taken literally. */
+                   if (len || (p > RExC_start && isALPHA_A(*(p - 1)))) {
+
+                        /* But, we raise a fatal warning otherwise, as the
+                         * deprecation cycle has come and gone.  Except that it
+                         * turns out that some heavily-relied on upstream
+                         * software, notably GNU Autoconf, have failed to fix
+                         * their uses.  For these, don't make it fatal unless
+                         * we anticipate using the '{' for something else.
+                         * This happens after any alpha, and for a looser {m,n}
+                         * quantifier specification */
+                        if (      RExC_strict
+                            || (  p > parse_start + 1
+                                && isALPHA_A(*(p - 1))
+                                && *(p - 2) == '\\')
+                            || new_regcurly(p, RExC_end))
                         {
                             RExC_parse = p + 1;
                             vFAIL("Unescaped left brace in regex is "
index 42e42b1..090eccb 100644 (file)
@@ -289,8 +289,6 @@ my @death =
  '/\w{/' => 'Unescaped left brace in regex is illegal here {#} m/\w{{#}/',
  '/\q{/' => 'Unescaped left brace in regex is illegal here {#} m/\q{{#}/',
  '/\A{/' => 'Unescaped left brace in regex is illegal here {#} m/\A{{#}/',
- '/:{4,a}/' => 'Unescaped left brace in regex is illegal here {#} m/:{{#}4,a}/',
- '/xa{3\,4}y/' => 'Unescaped left brace in regex is illegal here {#} m/xa{{#}3\,4}y/',
  '/abc/xix' => "",
  '/(?xmsixp:abc)/' => "",
  '/(?xmsixp)abc/' => "",
@@ -377,6 +375,12 @@ my @death_only_under_strict = (
                                      => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]\x{100}/',
     '/[a\zb]\x{100}/' => 'Unrecognized escape \z in character class passed through {#} m/[a\z{#}b]\x{100}/',
                       => 'Unrecognized escape \z in character class {#} m/[a\z{#}b]\x{100}/',
+    'default_on/:{4,a}/'     => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/:{{#}4,a}/',
+                             => 'Unescaped left brace in regex is illegal here {#} m/:{{#}4,a}/',
+    'default_on/xa{3\,4}y/'  => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/xa{{#}3\,4}y/',
+                             => 'Unescaped left brace in regex is illegal here {#} m/xa{{#}3\,4}y/',
+  'default_on/\\${[^\\}]*}/' => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/\\${{#}[^\\}]*}/',
+                             => 'Unescaped left brace in regex is illegal here {#} m/\\${{#}[^\\}]*}/',
 );
 
 # These need the character 'ネ' as a marker for mark_as_utf8()
@@ -657,7 +661,6 @@ my @deprecated = (
  '/.{/'         => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/.{{#}/',
  '/[x]{/'       => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/[x]{{#}/',
  '/\p{Latin}{/' => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/\p{Latin}{{#}/',
- '/\\${[^\\}]*}/' => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/\\${{#}[^\\}]*}/',
 );
 
 for my $strict ("", "use re 'strict';") {