From 934970aa10783f6f60f8eedab95c710f4d4eaa35 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 28 Nov 2011 08:24:07 -0700 Subject: [PATCH] utf8.c: Add flag to swash_init() to not croak on error This adds the capability, to be used in future commits, for swash_ini() to return NULL instead of croaking if it can't find a property, so that the caller can choose how to handle the situation. --- embed.fnc | 3 ++- embed.h | 2 +- proto.h | 2 +- utf8.c | 9 +++++++-- 4 files changed, 11 insertions(+), 5 deletions(-) diff --git a/embed.fnc b/embed.fnc index 9d2f239ccc..1cb3f3d09a 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1387,7 +1387,8 @@ EXMp |void |_append_range_to_invlist |NN SV* const invlist|const UV start|cons EXMp |void |_invlist_populate_swatch |NN SV* const invlist|const UV start|const UV end|NN U8* swatch #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) -EXp |SV* |_core_swash_init|NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none +EXp |SV* |_core_swash_init|NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits \ + |I32 none|bool return_if_undef #endif Ap |void |taint_env Ap |void |taint_proper |NULLOK const char* f|NN const char *const s diff --git a/embed.h b/embed.h index 8f0b74e640..88aa29dec5 100644 --- a/embed.h +++ b/embed.h @@ -944,7 +944,7 @@ #define study_chunk(a,b,c,d,e,f,g,h,i,j,k) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k) # endif # if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) -#define _core_swash_init(a,b,c,d,e) Perl__core_swash_init(aTHX_ a,b,c,d,e) +#define _core_swash_init(a,b,c,d,e,f) Perl__core_swash_init(aTHX_ a,b,c,d,e,f) # endif # if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C) #define _append_range_to_invlist(a,b,c) Perl__append_range_to_invlist(aTHX_ a,b,c) diff --git a/proto.h b/proto.h index c4dc4b326c..0c6a675bed 100644 --- a/proto.h +++ b/proto.h @@ -6530,7 +6530,7 @@ STATIC I32 S_study_chunk(pTHX_ struct RExC_state_t *pRExC_state, regnode **scanp #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) -PERL_CALLCONV SV* Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV* listsv, I32 minbits, I32 none) +PERL_CALLCONV SV* Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV* listsv, I32 minbits, I32 none, bool return_if_undef) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); diff --git a/utf8.c b/utf8.c index c8c6e55079..ed95c53832 100644 --- a/utf8.c +++ b/utf8.c @@ -2464,11 +2464,11 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits * public interface, and returning a copy prevents others from doing * mischief on the original */ - return newSVsv(_core_swash_init(pkg, name, listsv, minbits, none)); + return newSVsv(_core_swash_init(pkg, name, listsv, minbits, none, FALSE)); } SV* -Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none) +Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none, bool return_if_undef) { /* Initialize and return a swash, creating it if necessary. It does this * by calling utf8_heavy.pl. @@ -2552,6 +2552,11 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m } if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) { if (SvPOK(retval)) + + /* If caller wants to handle missing properties, let them */ + if (return_if_undef) { + return NULL; + } Perl_croak(aTHX_ "Can't find Unicode property definition \"%"SVf"\"", SVfARG(retval)); Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");