mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

utf8.c: Add flag to swash_init() to not croak on error

Browse Source 
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.
This commit is contained in:
Karl Williamson 2011-11-28 08:24:07 -07:00
parent 4065ba03da
commit 934970aa10
4 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
embed.fnc
View File

@ -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

2
embed.h
View File

@ -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)

2
proto.h
View File

@ -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);

9
utf8.c
View File

@ -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");