Move grok_blsash_o and make static
authorKarl Williamson <public@khwilliamson.com>
Wed, 9 Feb 2011 03:39:48 +0000 (20:39 -0700)
committerKarl Williamson <public@khwilliamson.com>
Thu, 10 Feb 2011 05:46:02 +0000 (22:46 -0700)
This function is only used in the same places as dquote_static.c is
used, so move it there, and we won't have to worry about changing its
API will break something.  No other changes made

dquote_static.c
embed.fnc
embed.h
global.sym
proto.h
util.c

index 4cc276f..dd58c6b 100644 (file)
@@ -35,6 +35,86 @@ S_regcurly(pTHX_ register const char *s)
        return FALSE;
     return TRUE;
 }
+
+STATIC bool
+S_grok_bslash_o(pTHX_ const char *s,
+                        UV *uv,
+                        STRLEN *len,
+                        const char** error_msg,
+                        const bool output_warning)
+{
+
+/*  Documentation to be supplied when interface nailed down finally
+ *  This returns FALSE if there is an error which the caller need not recover
+ *  from; , otherwise TRUE.  In either case the caller should look at *len
+ *  On input:
+ *     s   points to a string that begins with 'o', and the previous character
+ *         was a backslash.
+ *     uv  points to a UV that will hold the output value, valid only if the
+ *         return from the function is TRUE
+ *     len on success will point to the next character in the string past the
+ *                    end of this construct.
+ *         on failure, it will point to the failure
+ *      error_msg is a pointer that will be set to an internal buffer giving an
+ *         error message upon failure (the return is FALSE).  Untouched if
+ *         function succeeds
+ *     output_warning says whether to output any warning messages, or suppress
+ *         them
+ */
+    const char* e;
+    STRLEN numbers_len;
+    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
+               | PERL_SCAN_DISALLOW_PREFIX
+               /* XXX Until the message is improved in grok_oct, handle errors
+                * ourselves */
+               | PERL_SCAN_SILENT_ILLDIGIT;
+
+    PERL_ARGS_ASSERT_GROK_BSLASH_O;
+
+
+    assert(*s == 'o');
+    s++;
+
+    if (*s != '{') {
+       *len = 1;       /* Move past the o */
+       *error_msg = "Missing braces on \\o{}";
+       return FALSE;
+    }
+
+    e = strchr(s, '}');
+    if (!e) {
+       *len = 2;       /* Move past the o{ */
+       *error_msg = "Missing right brace on \\o{";
+       return FALSE;
+    }
+
+    /* Return past the '}' no matter what is inside the braces */
+    *len = e - s + 2;  /* 2 = 1 for the o + 1 for the '}' */
+
+    s++;    /* Point to first digit */
+
+    numbers_len = e - s;
+    if (numbers_len == 0) {
+       *error_msg = "Number with no digits";
+       return FALSE;
+    }
+
+    *uv = NATIVE_TO_UNI(grok_oct(s, &numbers_len, &flags, NULL));
+    /* Note that if has non-octal, will ignore everything starting with that up
+     * to the '}' */
+
+    if (output_warning && numbers_len != (STRLEN) (e - s)) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
+       /* diag_listed_as: Non-octal character '%c'.  Resolved as "%s" */
+                      "Non-octal character '%c'.  Resolved as \"\\o{%.*s}\"",
+                      *(s + numbers_len),
+                      (int) numbers_len,
+                      s);
+    }
+
+    return TRUE;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd
index f447db7..25c973a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -657,7 +657,9 @@ p   |OP*    |localize       |NN OP *o|I32 lex
 ApdR   |I32    |looks_like_number|NN SV *const sv
 Apd    |UV     |grok_bin       |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
 EXMpR  |char   |grok_bslash_c  |const char source|const bool output_warning
-EXMpR  |bool   |grok_bslash_o  |NN const char* s|NN UV* uv|NN STRLEN* len|NN const char** error_msg|const bool output_warning
+#ifdef PERL_IN_DQUOTE_STATIC_C
+EXMsR  |bool   |grok_bslash_o  |NN const char* s|NN UV* uv|NN STRLEN* len|NN const char** error_msg|const bool output_warning
+#endif
 Apd    |UV     |grok_hex       |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
 Apd    |int    |grok_number    |NN const char *pv|STRLEN len|NULLOK UV *valuep
 ApdR   |bool   |grok_numeric_radix|NN const char **sp|NN const char *send
diff --git a/embed.h b/embed.h
index fc351fd..66cdd67 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define _swash_to_invlist(a)   Perl__swash_to_invlist(aTHX_ a)
 #define av_reify(a)            Perl_av_reify(aTHX_ a)
 #define grok_bslash_c(a,b)     Perl_grok_bslash_c(aTHX_ a,b)
-#define grok_bslash_o(a,b,c,d,e)       Perl_grok_bslash_o(aTHX_ a,b,c,d,e)
 #define is_utf8_X_L(a)         Perl_is_utf8_X_L(aTHX_ a)
 #define is_utf8_X_LV(a)                Perl_is_utf8_X_LV(aTHX_ a)
 #define is_utf8_X_LVT(a)       Perl_is_utf8_X_LVT(aTHX_ a)
 #    endif
 #  endif
 #  if defined(PERL_IN_DQUOTE_STATIC_C)
+#define grok_bslash_o(a,b,c,d,e)       S_grok_bslash_o(aTHX_ a,b,c,d,e)
 #define regcurly(a)            S_regcurly(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_REGCOMP_C)
index 4a61e55..736087d 100644 (file)
@@ -152,7 +152,6 @@ Perl_gp_free
 Perl_gp_ref
 Perl_grok_bin
 Perl_grok_bslash_c
-Perl_grok_bslash_o
 Perl_grok_hex
 Perl_grok_number
 Perl_grok_numeric_radix
@@ -833,6 +832,7 @@ Perl_warn_nocontext
 Perl_warner_nocontext
 perl_alloc_using
 perl_clone_using
+Perl_grok_bslash_o
 Perl_sv_setsv_cow
 Perl_Slab_Alloc
 Perl_Slab_Free
diff --git a/proto.h b/proto.h
index bff673e..1d71cd5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1085,15 +1085,6 @@ PERL_CALLCONV UV Perl_grok_bin(pTHX_ const char* start, STRLEN* len_p, I32* flag
 PERL_CALLCONV char     Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
                        __attribute__warn_unused_result__;
 
-PERL_CALLCONV bool     Perl_grok_bslash_o(pTHX_ const char* s, UV* uv, STRLEN* len, const char** error_msg, const bool output_warning)
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2)
-                       __attribute__nonnull__(pTHX_3)
-                       __attribute__nonnull__(pTHX_4);
-#define PERL_ARGS_ASSERT_GROK_BSLASH_O \
-       assert(s); assert(uv); assert(len); assert(error_msg)
-
 PERL_CALLCONV UV       Perl_grok_hex(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
@@ -5194,6 +5185,15 @@ STATIC I32       S_do_trans_simple_utf8(pTHX_ SV * const sv)
 
 #endif
 #if defined(PERL_IN_DQUOTE_STATIC_C)
+STATIC bool    S_grok_bslash_o(pTHX_ const char* s, UV* uv, STRLEN* len, const char** error_msg, const bool output_warning)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_3)
+                       __attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT_GROK_BSLASH_O \
+       assert(s); assert(uv); assert(len); assert(error_msg)
+
 PERL_STATIC_INLINE I32 S_regcurly(pTHX_ const char *s)
                        __attribute__warn_unused_result__
                        __attribute__pure__
diff --git a/util.c b/util.c
index 8d9d2e4..414af22 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3956,85 +3956,6 @@ Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
     return result;
 }
 
-bool
-Perl_grok_bslash_o(pTHX_ const char *s,
-                        UV *uv,
-                        STRLEN *len,
-                        const char** error_msg,
-                        const bool output_warning)
-{
-
-/*  Documentation to be supplied when interface nailed down finally
- *  This returns FALSE if there is an error which the caller need not recover
- *  from; , otherwise TRUE.  In either case the caller should look at *len
- *  On input:
- *     s   points to a string that begins with 'o', and the previous character
- *         was a backslash.
- *     uv  points to a UV that will hold the output value, valid only if the
- *         return from the function is TRUE
- *     len on success will point to the next character in the string past the
- *                    end of this construct.
- *         on failure, it will point to the failure
- *      error_msg is a pointer that will be set to an internal buffer giving an
- *         error message upon failure (the return is FALSE).  Untouched if
- *         function succeeds
- *     output_warning says whether to output any warning messages, or suppress
- *         them
- */
-    const char* e;
-    STRLEN numbers_len;
-    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
-               | PERL_SCAN_DISALLOW_PREFIX
-               /* XXX Until the message is improved in grok_oct, handle errors
-                * ourselves */
-               | PERL_SCAN_SILENT_ILLDIGIT;
-
-    PERL_ARGS_ASSERT_GROK_BSLASH_O;
-
-
-    assert(*s == 'o');
-    s++;
-
-    if (*s != '{') {
-       *len = 1;       /* Move past the o */
-       *error_msg = "Missing braces on \\o{}";
-       return FALSE;
-    }
-
-    e = strchr(s, '}');
-    if (!e) {
-       *len = 2;       /* Move past the o{ */
-       *error_msg = "Missing right brace on \\o{";
-       return FALSE;
-    }
-
-    /* Return past the '}' no matter what is inside the braces */
-    *len = e - s + 2;  /* 2 = 1 for the o + 1 for the '}' */
-
-    s++;    /* Point to first digit */
-
-    numbers_len = e - s;
-    if (numbers_len == 0) {
-       *error_msg = "Number with no digits";
-       return FALSE;
-    }
-
-    *uv = NATIVE_TO_UNI(grok_oct(s, &numbers_len, &flags, NULL));
-    /* Note that if has non-octal, will ignore everything starting with that up
-     * to the '}' */
-
-    if (output_warning && numbers_len != (STRLEN) (e - s)) {
-       Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
-       /* diag_listed_as: Non-octal character '%c'.  Resolved as "%s" */
-                      "Non-octal character '%c'.  Resolved as \"\\o{%.*s}\"",
-                      *(s + numbers_len),
-                      (int) numbers_len,
-                      s);
-    }
-
-    return TRUE;
-}
-
 /* To workaround core dumps from the uninitialised tm_zone we get the
  * system to give us a reasonable struct to copy.  This fix means that
  * strftime uses the tm_zone and tm_gmtoff values returned by