This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8.c: Add a get_() method to hide internal details
authorKarl Williamson <public@khwilliamson.com>
Wed, 25 Jul 2012 02:53:41 +0000 (20:53 -0600)
committerKarl Williamson <public@khwilliamson.com>
Wed, 25 Jul 2012 03:13:50 +0000 (21:13 -0600)
This should have been written this way to begin with (I'm the culprit).
But we should have a method so another routine doesn't have to know the
internal details.

embed.fnc
embed.h
proto.h
regcomp.c
utf8.c

index 2e758aa..0c4e5ea 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1422,6 +1422,7 @@ EXp       |SV*    |_core_swash_init|NN const char* pkg|NN const char* name|NN SV* listsv|
                |bool passed_in_invlist_has_user_defined_property
 EXMpR  |SV*    |_invlist_contents|NN SV* const invlist
 EXMpR  |bool   |_is_swash_user_defined|NN SV* const swash
+EXMpR  |SV*    |_get_swash_invlist|NN SV* const swash
 #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 3af88ca..e97aa6a 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  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,f,g,h)      Perl__core_swash_init(aTHX_ a,b,c,d,e,f,g,h)
+#define _get_swash_invlist(a)  Perl__get_swash_invlist(aTHX_ a)
 #define _invlist_contents(a)   Perl__invlist_contents(aTHX_ a)
 #define _is_swash_user_defined(a)      Perl__is_swash_user_defined(aTHX_ a)
 #  endif
diff --git a/proto.h b/proto.h
index e6d0dbe..c8deaf9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6684,6 +6684,12 @@ PERL_CALLCONV SV*        Perl__core_swash_init(pTHX_ const char* pkg, const char* name,
 #define PERL_ARGS_ASSERT__CORE_SWASH_INIT      \
        assert(pkg); assert(name); assert(listsv)
 
+PERL_CALLCONV SV*      Perl__get_swash_invlist(pTHX_ SV* const swash)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT__GET_SWASH_INVLIST    \
+       assert(swash)
+
 PERL_CALLCONV SV*      Perl__invlist_contents(pTHX_ SV* const invlist)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
index fd2e735..ab9c705 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -11339,7 +11339,6 @@ parseit:
                    n = 1;
                }
                if (!SIZE_ONLY) {
-                    SV** invlistsvp;
                     SV* invlist;
                     char* name;
 
@@ -11381,10 +11380,7 @@ parseit:
                     if (   ! swash
                         || ! SvROK(swash)
                         || ! SvTYPE(SvRV(swash)) == SVt_PVHV
-                        || ! (invlistsvp =
-                               hv_fetchs(MUTABLE_HV(SvRV(swash)),
-                                "INVLIST", FALSE))
-                        || ! (invlist = *invlistsvp))
+                        || ! (invlist = _get_swash_invlist(swash)))
                    {
                         if (swash) {
                             SvREFCNT_dec(swash);
@@ -12071,7 +12067,7 @@ parseit:
             if (! PL_utf8_foldable) {
                 SV* swash = swash_init("utf8", "_Perl_Any_Folds",
                                        &PL_sv_undef, 1, 0);
-                PL_utf8_foldable = _swash_to_invlist(swash);
+                PL_utf8_foldable = _get_swash_invlist(swash);
                 SvREFCNT_dec(swash);
             }
 
diff --git a/utf8.c b/utf8.c
index 1596f87..8c3c891 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -4085,6 +4085,20 @@ Perl__is_swash_user_defined(pTHX_ SV* const swash)
     return cBOOL(SvUV(*ptr));
 }
 
+SV*
+Perl__get_swash_invlist(pTHX_ SV* const swash)
+{
+    SV** ptr = hv_fetchs(MUTABLE_HV(SvRV(swash)), "INVLIST", FALSE);
+
+    PERL_ARGS_ASSERT__GET_SWASH_INVLIST;
+
+    if (! ptr) {
+        return NULL;
+    }
+
+    return *ptr;
+}
+
 /*
 =for apidoc uvchr_to_utf8