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.

diff --git a/embed.fnc b/embed.fnc
index 9d2f239..1cb3f3d 100644 (file)
--- 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 8f0b74e..88aa29d 100644 (file)
--- 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 c4dc4b3..0c6a675 100644 (file)
--- 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 c8c6e55..ed95c53 100644 (file)
--- 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");