This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Extract functionality into a static function
authorKarl Williamson <khw@cpan.org>
Tue, 26 Aug 2014 23:29:31 +0000 (17:29 -0600)
committerKarl Williamson <khw@cpan.org>
Sun, 7 Sep 2014 03:12:05 +0000 (21:12 -0600)
This is in preparation for it being used in more than one place in a
future commit.

embed.fnc
embed.h
proto.h
regcomp.c

index 54c7f97..5d12c6d 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2194,6 +2194,7 @@ Es        |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \
                                |NULLOK const regnode *last \
                                |NULLOK const regnode *plast \
                                |NN SV* sv|I32 indent|U32 depth
+EnPs   |const char *|cntrl_to_mnemonic|const U8 c
 Es     |void   |put_code_point |NN SV* sv|UV c
 Es     |bool   |put_charclass_bitmap_innards|NN SV* sv     \
                                |NN char* bitmap            \
diff --git a/embed.h b/embed.h
index 2abc4e2..0fe9f7d 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define yylex()                        Perl_yylex(aTHX)
 #  if defined(DEBUGGING)
 #    if defined(PERL_IN_REGCOMP_C)
+#define cntrl_to_mnemonic      S_cntrl_to_mnemonic
 #define dump_trie(a,b,c,d)     S_dump_trie(aTHX_ a,b,c,d)
 #define dump_trie_interim_list(a,b,c,d,e)      S_dump_trie_interim_list(aTHX_ a,b,c,d,e)
 #define dump_trie_interim_table(a,b,c,d,e)     S_dump_trie_interim_table(aTHX_ a,b,c,d,e)
diff --git a/proto.h b/proto.h
index af28f6c..91a42c8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5356,6 +5356,9 @@ STATIC void       S_cv_dump(pTHX_ const CV *cv, const char *title)
 
 #  endif
 #  if defined(PERL_IN_REGCOMP_C)
+STATIC const char *    S_cntrl_to_mnemonic(const U8 c)
+                       __attribute__pure__;
+
 STATIC void    S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV* widecharmap, AV *revcharmap, U32 depth)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_3);
index a1422d0..c6d2fec 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -800,6 +800,30 @@ DEBUG_OPTIMISE_MORE_r(if(data){                                      \
     PerlIO_printf(Perl_debug_log,"\n");                              \
 });
 
+#ifdef DEBUGGING
+
+STATIC const char *
+S_cntrl_to_mnemonic(const U8 c)
+{
+    /* Returns the mnemonic string that represents character 'c', if one
+     * exists; NULL otherwise.  The only ones that exist for the purposes of
+     * this routine are a few control characters */
+
+    switch (c) {
+        case '\a':       return "\\a";
+        case '\b':       return "\\b";
+        case ESC_NATIVE: return "\\e";
+        case '\f':       return "\\f";
+        case '\n':       return "\\n";
+        case '\r':       return "\\r";
+        case '\t':       return "\\t";
+    }
+
+    return NULL;
+}
+
+#endif
+
 /* Mark that we cannot extend a found fixed substring at this point.
    Update the longest found anchored substring and the longest found
    floating substrings if needed. */
@@ -16714,15 +16738,12 @@ S_put_code_point(pTHX_ SV *sv, UV c)
        sv_catpvn(sv, &string, 1);
     }
     else {
-        switch ((U8) c) {
-            case '\a': Perl_sv_catpvf(aTHX_ sv, "\\a"); break;
-            case '\b': Perl_sv_catpvf(aTHX_ sv, "\\b"); break;
-            case ESC_NATIVE: Perl_sv_catpvf(aTHX_ sv, "\\e"); break;
-            case '\f': Perl_sv_catpvf(aTHX_ sv, "\\f"); break;
-            case '\n': Perl_sv_catpvf(aTHX_ sv, "\\n"); break;
-            case '\r': Perl_sv_catpvf(aTHX_ sv, "\\r"); break;
-            case '\t': Perl_sv_catpvf(aTHX_ sv, "\\t"); break;
-            default: Perl_sv_catpvf(aTHX_ sv, "\\x{%02X}", (U8) c); break;
+        const char * const mnemonic = cntrl_to_mnemonic((char) c);
+        if (mnemonic) {
+            Perl_sv_catpvf(aTHX_ sv, "%s", mnemonic);
+        }
+        else {
+            Perl_sv_catpvf(aTHX_ sv, "\\x{%02X}", (U8) c);
         }
     }
 }