In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/454155d98d52c903969d4c71a5cd1f2f269aaf5f?hp=936fbabe1d1671d8f272f1745c2abfdef39067d1>
- Log -----------------------------------------------------------------
commit 454155d98d52c903969d4c71a5cd1f2f269aaf5f
Author: Karl Williamson <k...@khw-desktop.(none)>
Date: Sun Jul 25 13:13:10 2010 -0600
Change function signature of grok_bslash_o
The previous return value where NULL meant OK is outside-the-norm.
M embed.fnc
M embed.h
M proto.h
M regcomp.c
M t/lib/warnings/regcomp
M toke.c
M util.c
commit 154bd5274ebc449c2a37261db17c2e721d16078d
Author: Karl Williamson <k...@khw-desktop.(none)>
Date: Sun Jul 25 11:48:05 2010 -0600
Correct pod in numeric.c
M numeric.c
commit 632403ccc5fce570d9c89f91262232622dc18738
Author: Karl Williamson <k...@khw-desktop.(none)>
Date: Sun Jul 25 11:46:45 2010 -0600
Correct comment in toke.c
M toke.c
commit 1c149325354b2f495f253338a532cd7c0ee4a34d
Author: Karl Williamson <k...@khw-desktop.(none)>
Date: Sun Jul 25 11:18:39 2010 -0600
embed.fnc: correct comments
M embed.fnc
commit 99a767497aefe18d89f5797f9871483537389bbf
Author: Karl Williamson <k...@khw-desktop.(none)>
Date: Sun Jul 25 11:15:56 2010 -0600
Mark grok_bslash functions as intfce changeable
M embed.fnc
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 8 ++++----
embed.h | 2 +-
numeric.c | 2 +-
proto.h | 7 ++++---
regcomp.c | 35 ++++++++++++++++++++---------------
t/lib/warnings/regcomp | 12 ++++++------
toke.c | 7 ++++---
util.c | 39 ++++++++++++++++++++++++++-------------
8 files changed, 66 insertions(+), 46 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 8f9cebf..289538f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -13,7 +13,7 @@
: A Member of public API:
:
: add entry to global.sym (unless x or m);
-: any doc entry goes in perlapi.pod rather than perlintern.api
+: any doc entry goes in perlapi.pod rather than perlintern.pod
: makes '#define foo Perl_foo' scope not just for PERL_CORE/PERL_EXT
:
: a Allocates memory a la malloc/calloc. Also implies "R":
@@ -48,7 +48,7 @@
:
: M May change:
:
-: (currently no effect)
+: any doc entry is marked that function may change
:
: m Implemented as a macro:
:
@@ -640,8 +640,8 @@ Ap |void |vload_module|U32 flags|NN SV* name|NULLOK SV*
ver|NULLOK va_list* args
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
-EXpR |char |grok_bslash_c |const char source|const bool output_warning
-EXpR |char* |grok_bslash_o |NN const char* s|NN UV* uv|NN STRLEN*
len|const bool output_warning
+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
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 5312d22..6f5e151 100644
--- a/embed.h
+++ b/embed.h
@@ -2912,7 +2912,7 @@
#define grok_bin(a,b,c,d) Perl_grok_bin(aTHX_ a,b,c,d)
#if defined(PERL_CORE) || defined(PERL_EXT)
#define grok_bslash_c(a,b) Perl_grok_bslash_c(aTHX_ a,b)
-#define grok_bslash_o(a,b,c,d) Perl_grok_bslash_o(aTHX_ a,b,c,d)
+#define grok_bslash_o(a,b,c,d,e) Perl_grok_bslash_o(aTHX_ a,b,c,d,e)
#endif
#define grok_hex(a,b,c,d) Perl_grok_hex(aTHX_ a,b,c,d)
#define grok_number(a,b,c) Perl_grok_number(aTHX_ a,b,c)
diff --git a/numeric.c b/numeric.c
index e7e740f..c9423ce 100644
--- a/numeric.c
+++ b/numeric.c
@@ -349,7 +349,7 @@ On entry I<start> and I<*len> give the string to scan,
I<*flags> gives
conversion flags, and I<result> should be NULL or a pointer to an NV.
The scan stops at the end of the string, or the first invalid character.
Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
-invalid character will also trigger a warning.
+8 or 9 will also trigger a warning.
On return I<*len> is set to the length of the scanned string,
and I<*flags> gives output flags.
diff --git a/proto.h b/proto.h
index 274509a..6c5fc52 100644
--- a/proto.h
+++ b/proto.h
@@ -1634,13 +1634,14 @@ 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 char* Perl_grok_bslash_o(pTHX_ const char* s, UV* uv, STRLEN*
len, const bool output_warning)
+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_3)
+ __attribute__nonnull__(pTHX_4);
#define PERL_ARGS_ASSERT_GROK_BSLASH_O \
- assert(s); assert(uv); assert(len)
+ 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)
diff --git a/regcomp.c b/regcomp.c
index 1cc2e10..43b881d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7360,7 +7360,6 @@ tryagain:
register UV ender;
register char *p;
char *s;
- char *error_msg;
STRLEN foldlen;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
@@ -7465,19 +7464,23 @@ tryagain:
{
STRLEN brace_len = len;
UV result;
- if ((error_msg = grok_bslash_o(p,
- &result,
- &brace_len,
- SIZE_ONLY))
- != NULL)
- {
+ const char* error_msg;
+
+ bool valid = grok_bslash_o(p,
+ &result,
+ &brace_len,
+ &error_msg,
+ 1);
+ p += brace_len;
+ if (! valid) {
+ RExC_parse = p; /* going to die anyway; point
+ to exact spot of failure */
vFAIL(error_msg);
}
else
{
ender = result;
}
- p += brace_len;
if (PL_encoding && ender < 0x100) {
goto recode_encoding;
}
@@ -7995,7 +7998,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth)
parseit:
while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != ']') {
- char* error_msg;
charclassloop:
@@ -8104,15 +8106,18 @@ parseit:
case 'a': value = ASCII_TO_NATIVE('\007');break;
case 'o':
RExC_parse--; /* function expects to be pointed at the 'o' */
- if ((error_msg = grok_bslash_o(RExC_parse,
+ {
+ const char* error_msg;
+ bool valid = grok_bslash_o(RExC_parse,
&value,
&numlen,
- SIZE_ONLY))
- != NULL)
- {
- vFAIL(error_msg);
+ &error_msg,
+ SIZE_ONLY);
+ RExC_parse += numlen;
+ if (! valid) {
+ vFAIL(error_msg);
+ }
}
- RExC_parse += numlen;
if (PL_encoding && value < 0x100) {
goto recode_encoding;
}
diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp
index 3f80ccc..6bc6845 100644
--- a/t/lib/warnings/regcomp
+++ b/t/lib/warnings/regcomp
@@ -211,29 +211,29 @@ Useless (?c) - use /gc modifier in regex; marked by <--
HERE in m/(?ogc <-- HERE
# regcomp.c [S_regatom]
$a = qr/\o{/;
EXPECT
-Missing right brace on \o{ in regex; marked by <-- HERE in m/\ <-- HERE o{/ at
- line 2.
+Missing right brace on \o{ in regex; marked by <-- HERE in m/\o{ <-- HERE / at
- line 2.
########
# regcomp.c [S_regatom]
$a = qr/\o/;
EXPECT
-Missing braces on \o{} in regex; marked by <-- HERE in m/\ <-- HERE o/ at -
line 2.
+Missing braces on \o{} in regex; marked by <-- HERE in m/\o <-- HERE / at -
line 2.
########
# regcomp.c [S_regatom]
$a = qr/\o{}/;
EXPECT
-Number with no digits in regex; marked by <-- HERE in m/\ <-- HERE o{}/ at -
line 2.
+Number with no digits in regex; marked by <-- HERE in m/\o{} <-- HERE / at -
line 2.
########
# regcomp.c [S_regclass]
$a = qr/[\o{]/;
EXPECT
-Missing right brace on \o{ in regex; marked by <-- HERE in m/[\ <-- HERE o{]/
at - line 2.
+Missing right brace on \o{ in regex; marked by <-- HERE in m/[\o{ <-- HERE ]/
at - line 2.
########
# regcomp.c [S_regclass]
$a = qr/[\o]/;
EXPECT
-Missing braces on \o{} in regex; marked by <-- HERE in m/[\ <-- HERE o]/ at -
line 2.
+Missing braces on \o{} in regex; marked by <-- HERE in m/[\o <-- HERE ]/ at -
line 2.
########
# regcomp.c [S_regclass]
$a = qr/[\o{}]/;
EXPECT
-Number with no digits in regex; marked by <-- HERE in m/[\ <-- HERE o{}]/ at -
line 2.
+Number with no digits in regex; marked by <-- HERE in m/[\o{} <-- HERE ]/ at -
line 2.
diff --git a/toke.c b/toke.c
index 1e7cdb5..455f977 100644
--- a/toke.c
+++ b/toke.c
@@ -2868,7 +2868,7 @@ S_scan_const(pTHX_ char *start)
goto default_action;
}
- /* eg. \132 indicates the octal constant 0x132 */
+ /* eg. \132 indicates the octal constant 0132 */
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
{
@@ -2883,10 +2883,11 @@ S_scan_const(pTHX_ char *start)
case 'o':
{
STRLEN len;
+ const char* error;
- char* error = grok_bslash_o(s, &uv, &len, 1);
+ bool valid = grok_bslash_o(s, &uv, &len, &error, 1);
s += len;
- if (error) {
+ if (! valid) {
yyerror(error);
continue;
}
diff --git a/util.c b/util.c
index 5bfe354..9e1e2c8 100644
--- a/util.c
+++ b/util.c
@@ -3935,18 +3935,28 @@ Perl_grok_bslash_c(pTHX_ const char source, const bool
output_warning)
return result;
}
-char *
-Perl_grok_bslash_o(pTHX_ const char *s, UV *uv, STRLEN *len, const bool
output_warning)
+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 NULL on success, otherwise a pointer to an internal constant
- * error message. 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
- * len will point to the next character in the string past the end of this
- * construct
+ * 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
*/
@@ -3966,13 +3976,15 @@ Perl_grok_bslash_o(pTHX_ const char *s, UV *uv, STRLEN
*len, const bool output_w
if (*s != '{') {
*len = 1; /* Move past the o */
- return "Missing braces on \\o{}";
+ *error_msg = "Missing braces on \\o{}";
+ return FALSE;
}
e = strchr(s, '}');
if (!e) {
*len = 2; /* Move past the o{ */
- return "Missing right brace on \\o{";
+ *error_msg = "Missing right brace on \\o{";
+ return FALSE;
}
/* Return past the '}' no matter what is inside the braces */
@@ -3982,7 +3994,8 @@ Perl_grok_bslash_o(pTHX_ const char *s, UV *uv, STRLEN
*len, const bool output_w
numbers_len = e - s;
if (numbers_len == 0) {
- return "Number with no digits";
+ *error_msg = "Number with no digits";
+ return FALSE;
}
*uv = NATIVE_TO_UNI(grok_oct(s, &numbers_len, &flags, NULL));
@@ -3998,7 +4011,7 @@ Perl_grok_bslash_o(pTHX_ const char *s, UV *uv, STRLEN
*len, const bool output_w
s);
}
- return NULL;
+ return TRUE;
}
/* To workaround core dumps from the uninitialised tm_zone we get the
--
Perl5 Master Repository
