#define force_strict_version(a) S_force_strict_version(aTHX_ a)
#define force_version(a,b) S_force_version(aTHX_ a,b)
#define force_word(a,b,c,d) S_force_word(aTHX_ a,b,c,d)
-#define get_and_check_backslash_N_name(a,b) S_get_and_check_backslash_N_name(aTHX_ a,b)
+#define get_and_check_backslash_N_name(a,b,c) S_get_and_check_backslash_N_name(aTHX_ a,b,c)
+#define get_and_check_backslash_N_name_wrapper(a,b) S_get_and_check_backslash_N_name_wrapper(aTHX_ a,b)
#define incline(a,b) S_incline(aTHX_ a,b)
#define intuit_method(a,b,c) S_intuit_method(aTHX_ a,b,c)
#define intuit_more(a,b) S_intuit_more(aTHX_ a,b)
STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack);
#define PERL_ARGS_ASSERT_FORCE_WORD \
assert(start)
-STATIC SV* S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
+STATIC SV* S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e, const char** error_msg)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME \
+ assert(s); assert(e); assert(error_msg)
+
+STATIC SV* S_get_and_check_backslash_N_name_wrapper(pTHX_ const char* s, const char* const e)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME_WRAPPER \
assert(s); assert(e)
STATIC void S_incline(pTHX_ const char *s, const char *end);
}
STATIC SV*
-S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
+S_get_and_check_backslash_N_name_wrapper(pTHX_ const char* s, const char* const e)
+{
+ /* This justs wraps get_and_check_backslash_N_name() to output any error
+ * message it returns. */
+
+ const char * error_msg = NULL;
+ SV * result = get_and_check_backslash_N_name(s, e, &error_msg);
+
+ PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME_WRAPPER;
+
+ if (error_msg) {
+ yyerror_pv(error_msg, UTF ? SVf_UTF8 : 0);
+ }
+
+ return result;
+}
+
+STATIC SV*
+S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e, const char ** error_msg)
{
/* <s> points to first character of interior of \N{}, <e> to one beyond the
* interior, hence to the "}". Finds what the name resolves to, returning
if (!SvCUR(res)) {
SvREFCNT_dec_NN(res);
/* diag_listed_as: Unknown charname '%s' */
- yyerror("Unknown charname ''");
+ *error_msg = Perl_form(aTHX_ "Unknown charname ''");
return NULL;
}
res = new_constant( NULL, 0, "charnames", res, NULL, backslash_ptr,
/* include the <}> */
- e - backslash_ptr + 1, NULL);
+ e - backslash_ptr + 1, error_msg);
if (! SvPOK(res)) {
SvREFCNT_dec_NN(res);
return NULL;
/* diag_listed_as: charnames alias definitions may not contain
trailing white-space; marked by <-- HERE in %s
*/
- yyerror_pv(
- Perl_form(aTHX_
+ *error_msg = Perl_form(aTHX_
"charnames alias definitions may not contain trailing "
"white-space; marked by <-- HERE in %.*s<-- HERE %.*s",
(int)(s - backslash_ptr + 1), backslash_ptr,
- (int)(e - s + 1), s + 1
- ),
- UTF ? SVf_UTF8 : 0);
+ (int)(e - s + 1), s + 1);
return NULL;
}
0 /* 0 means don't die */ );
/* diag_listed_as: Malformed UTF-8 returned by \N{%s}
immediately after '%s' */
- yyerror_pv(
- Perl_form(aTHX_
+ *error_msg = Perl_form(aTHX_
"Malformed UTF-8 returned by %.*s immediately after '%.*s'",
(int) (e - backslash_ptr + 1), backslash_ptr,
- (int) ((char *) first_bad_char_loc - str), str
- ),
- SVf_UTF8);
+ (int) ((char *) first_bad_char_loc - str), str);
return NULL;
}
}
* that this print won't run off the end of the string */
/* diag_listed_as: Invalid character in \N{...}; marked by <-- HERE
in \N{%s} */
- yyerror_pv(
- Perl_form(aTHX_
+ *error_msg = Perl_form(aTHX_
"Invalid character in \\N{...}; marked by <-- HERE in %.*s<-- HERE %.*s",
(int)(s - backslash_ptr + 1), backslash_ptr,
- (int)(e - s + 1), s + 1
- ),
- UTF ? SVf_UTF8 : 0);
+ (int)(e - s + 1), s + 1);
return NULL;
}
/* diag_listed_as: charnames alias definitions may not contain a
sequence of multiple spaces; marked by <-- HERE
in %s */
- yyerror_pv(
- Perl_form(aTHX_
+ *error_msg = Perl_form(aTHX_
"charnames alias definitions may not contain a sequence of "
"multiple spaces; marked by <-- HERE in %.*s<-- HERE %.*s",
(int)(s - backslash_ptr + 1), backslash_ptr,
- (int)(e - s + 1), s + 1
- ),
- UTF ? SVf_UTF8 : 0);
+ (int)(e - s + 1), s + 1);
return NULL;
}
}
}
else /* Here is \N{NAME} but not \N{U+...}. */
- if ((res = get_and_check_backslash_N_name(s, e)))
+ if ((res = get_and_check_backslash_N_name_wrapper(s, e)))
{
STRLEN len;
const char *str = SvPV_const(res, len);