Restructure grok_bslash_c

This commit causes this function to allow a caller to request any
messages generated to be returned to the caller, instead of always being
handled within this function.

Like the previous commit for grok_bslash_c, here are two reasons to do
this, repeated here.

1) In pattern compilation this brings these messages into conformity
   with the other ones that get generated in pattern compilation, where
   there is a particular syntax, including marking the exact position in
   the parse where the problem occurred.

2) The messages could be truncated due to the (mostly) single-pass
   nature of pattern compilation that is now in effect.  It keeps track
   of where during a parse a message has been output, and won't output
   it again if a second parsing pass turns out to be necessary.  Prior
   to this commit, it had to assume that a message from one of these
   functions did get output, and this caused some out-of-bounds reads
   when a subparse (using a constructed pattern) was executed.  The
   possibility of those went away in commit 5d894ca5213, which
   guarantees it won't try to read outside bounds, but that may still
   mean it is outputting text from the wrong parse, giving meaningless
   results.  This commit should stop that possibility.

1 files changed, 45 insertions, 21 deletions

diff --git a/dquote.c b/dquote.c
index 3a2ba46c26..d6e442e950 100644
--- a/dquote.c
+++ b/dquote.c
@@ -11,48 +11,72 @@
 #include "dquote_inline.h"
 
 /* XXX Add documentation after final interface and behavior is decided */
-/* May want to show context for error, so would pass S_grok_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning)
-    U8 source = *current;
-*/
 
-char
-Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
+bool
+Perl_grok_bslash_c(pTHX_ const char   source,
+                         U8 *         result,
+                         const char** message,
+                         U32 *        packed_warn)
 {
-
-    U8 result;
+    PERL_ARGS_ASSERT_GROK_BSLASH_C;
+
+    /* This returns TRUE if the \c? sequence is valid; FALSE otherwise.  If it
+     * is valid, the sequence evaluates to a single character, which will be
+     * stored into *result.
+     *
+     * source   is the character immediately after a '\c' sequence.
+     * result   points to a char variable into which this function will store
+     *          what the sequence evaluates to, if valid; unchanged otherwise.
+     * message  A pointer to any warning or error message will be stored into
+     *          this pointer; NULL if none.
+     * packed_warn if NULL on input asks that this routine display any warning
+     *          messages.  Otherwise, if the function found a warning, the
+     *          packed warning categories will be stored into *packed_warn (and
+     *          the corresponding message text into *message); 0 if none.
+     */
+
+    *message = NULL;
+    if (packed_warn) *packed_warn = 0;
 
     if (! isPRINT_A(source)) {
-        Perl_croak(aTHX_ "%s",
-                        "Character following \"\\c\" must be printable ASCII");
+        *message = "Character following \"\\c\" must be printable ASCII";
+        return FALSE;
     }
-    else if (source == '{') {
+
+    if (source == '{') {
         const char control = toCTRL('{');
         if (isPRINT_A(control)) {
             /* diag_listed_as: Use "%s" instead of "%s" */
-            Perl_croak(aTHX_ "Use \"%c\" instead of \"\\c{\"", control);
+            *message = Perl_form(aTHX_ "Use \"%c\" instead of \"\\c{\"", control);
         }
         else {
-            Perl_croak(aTHX_ "Sequence \"\\c{\" invalid");
+            *message = "Sequence \"\\c{\" invalid";
         }
+        return FALSE;
     }
 
-    result = toCTRL(source);
-    if (output_warning && isPRINT_A(result)) {
+    *result = toCTRL(source);
+    if (isPRINT_A(*result) && ckWARN(WARN_SYNTAX)) {
         U8 clearer[3];
         U8 i = 0;
-        if (! isWORDCHAR(result)) {
+        char format[] = "\"\\c%c\" is more clearly written simply as \"%s\"";
+
+        if (! isWORDCHAR(*result)) {
             clearer[i++] = '\\';
         }
-        clearer[i++] = result;
+        clearer[i++] = *result;
         clearer[i++] = '\0';
 
-        Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
-                        "\"\\c%c\" is more clearly written simply as \"%s\"",
-                        source,
-                        clearer);
+        if (packed_warn) {
+            *message = Perl_form(aTHX_ format, source, clearer);
+            *packed_warn = packWARN(WARN_SYNTAX);
+        }
+        else {
+            Perl_warner(aTHX_ packWARN(WARN_SYNTAX), format, source, clearer);
+        }
     }
 
-    return result;
+    return TRUE;
 }
 
 bool