This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8.c: Rmv no longer used function
authorKarl Williamson <khw@cpan.org>
Sat, 31 Mar 2018 18:14:45 +0000 (12:14 -0600)
committerKarl Williamson <khw@cpan.org>
Sat, 31 Mar 2018 21:36:46 +0000 (15:36 -0600)
The previous commit completely stopped using this core-only function.
Remove it.

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

index 095b528..057e1e9 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1745,7 +1745,6 @@ EiMRn     |UV     |_invlist_len   |NN SV* const invlist
 EMiRn  |bool   |_invlist_contains_cp|NN SV* const invlist|const UV cp
 EXpMRn |SSize_t|_invlist_search        |NN SV* const invlist|const UV cp
 EXMpR  |SV*    |_get_swash_invlist|NN SV* const swash
 EMiRn  |bool   |_invlist_contains_cp|NN SV* const invlist|const UV cp
 EXpMRn |SSize_t|_invlist_search        |NN SV* const invlist|const UV cp
 EXMpR  |SV*    |_get_swash_invlist|NN SV* const swash
-EXMpR  |HV*    |_swash_inversion_hash
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
 EXpM   |SV*    |_get_regclass_nonbitmap_data                              \
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
 EXpM   |SV*    |_get_regclass_nonbitmap_data                              \
diff --git a/embed.h b/embed.h
index a6189a1..0f0d457 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define _invlist_contains_cp   S__invlist_contains_cp
 #define _invlist_len           S__invlist_len
 #define _invlist_search                Perl__invlist_search
 #define _invlist_contains_cp   S__invlist_contains_cp
 #define _invlist_len           S__invlist_len
 #define _invlist_search                Perl__invlist_search
-#define _swash_inversion_hash()        Perl__swash_inversion_hash(aTHX)
 #define get_invlist_offset_addr        S_get_invlist_offset_addr
 #define invlist_array          S_invlist_array
 #  endif
 #define get_invlist_offset_addr        S_get_invlist_offset_addr
 #define invlist_array          S_invlist_array
 #  endif
diff --git a/proto.h b/proto.h
index ebead79..93e5c96 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5474,9 +5474,6 @@ PERL_CALLCONV SSize_t     Perl__invlist_search(SV* const invlist, const UV cp)
 #define PERL_ARGS_ASSERT__INVLIST_SEARCH       \
        assert(invlist)
 
 #define PERL_ARGS_ASSERT__INVLIST_SEARCH       \
        assert(invlist)
 
-PERL_CALLCONV HV*      Perl__swash_inversion_hash(pTHX)
-                       __attribute__warn_unused_result__;
-
 #ifndef PERL_NO_INLINE_FUNCTIONS
 PERL_STATIC_INLINE bool*       S_get_invlist_offset_addr(SV* invlist)
                        __attribute__warn_unused_result__;
 #ifndef PERL_NO_INLINE_FUNCTIONS
 PERL_STATIC_INLINE bool*       S_get_invlist_offset_addr(SV* invlist)
                        __attribute__warn_unused_result__;
diff --git a/utf8.c b/utf8.c
index 7c5262e..8ba6819 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -5111,321 +5111,6 @@ S_swatch_get(pTHX_ SV* swash, UV start, UV span)
     return swatch;
 }
 
     return swatch;
 }
 
-HV*
-Perl__swash_inversion_hash(pTHX)
-{
-
-   /* Subject to change or removal.  For use only in regcomp.c and regexec.c
-    * Can't be used on a property that is subject to user override, as it
-    * relies on the value of SPECIALS in the swash which would be set by
-    * utf8_heavy.pl to the hash in the non-overriden file, and hence is not set
-    * for overridden properties
-    *
-    * Returns a hash which is the inversion and closure of a swash mapping.
-    * For example, consider the input lines:
-    * 004B             006B
-    * 004C             006C
-    * 212A             006B
-    *
-    * The returned hash would have two keys, the UTF-8 for 006B and the UTF-8 for
-    * 006C.  The value for each key is an array.  For 006C, the array would
-    * have two elements, the UTF-8 for itself, and for 004C.  For 006B, there
-    * would be three elements in its array, the UTF-8 for 006B, 004B and 212A.
-    *
-    * Note that there are no elements in the hash for 004B, 004C, 212A.  The
-    * keys are only code points that are folded-to, so it isn't a full closure.
-    *
-    * Essentially, for any code point, it gives all the code points that map to
-    * it, or the list of 'froms' for that point.
-    *
-    * Currently it ignores any additions or deletions from other swashes,
-    * looking at just the main body of the swash, and if there are SPECIALS
-    * in the swash, at that hash
-    *
-    * The specials hash can be extra code points, and most likely consists of
-    * maps from single code points to multiple ones (each expressed as a string
-    * of UTF-8 characters).   This function currently returns only 1-1 mappings.
-    * However consider this possible input in the specials hash:
-    * "\xEF\xAC\x85" => "\x{0073}\x{0074}",         # U+FB05 => 0073 0074
-    * "\xEF\xAC\x86" => "\x{0073}\x{0074}",         # U+FB06 => 0073 0074
-    *
-    * Both FB05 and FB06 map to the same multi-char sequence, which we don't
-    * currently handle.  But it also means that FB05 and FB06 are equivalent in
-    * a 1-1 mapping which we should handle, and this relationship may not be in
-    * the main table.  Therefore this function examines all the multi-char
-    * sequences and adds the 1-1 mappings that come out of that.
-    *
-    * XXX This function was originally intended to be multipurpose, but its
-    * only use is quite likely to remain for constructing the inversion of
-    * the CaseFolding (//i) property.  If it were more general purpose for
-    * regex patterns, it would have to do the FB05/FB06 game for simple folds,
-    * because certain folds are prohibited under /iaa and /il.  As an example,
-    * in Unicode 3.0.1 both U+0130 and U+0131 fold to 'i', and hence are both
-    * equivalent under /i.  But under /iaa and /il, the folds to 'i' are
-    * prohibited, so we would not figure out that they fold to each other.
-    * Code could be written to automatically figure this out, similar to the
-    * code that does this for multi-character folds, but this is the only case
-    * where something like this is ever likely to happen, as all the single
-    * char folds to the 0-255 range are now quite settled.  Instead there is a
-    * little special code that is compiled only for this Unicode version.  This
-    * is smaller and didn't require much coding time to do.  But this makes
-    * this routine strongly tied to being used just for CaseFolding.  If ever
-    * it should be generalized, this would have to be fixed */
-
-    U8 *l, *lend;
-    STRLEN lcur;
-    SV * swash = _core_swash_init("utf8", "ToCf", &PL_sv_undef, 4, 0, NULL, NULL);
-    HV *const hv = MUTABLE_HV(SvRV(swash));
-
-    /* The string containing the main body of the table.  This will have its
-     * assertion fail if the swash has been converted to its inversion list */
-    SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
-
-    SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);
-    SV** const bitssvp = hv_fetchs(hv, "BITS", FALSE);
-    SV** const nonesvp = hv_fetchs(hv, "NONE", FALSE);
-    /*SV** const extssvp = hv_fetchs(hv, "EXTRAS", FALSE);*/
-    const U8* const typestr = (U8*)SvPV_nolen(*typesvp);
-    const STRLEN bits  = SvUV(*bitssvp);
-    const STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
-    const UV     none  = SvUV(*nonesvp);
-    SV **specials_p = hv_fetchs(hv, "SPECIALS", 0);
-
-    HV* ret = newHV();
-
-    /* Must have at least 8 bits to get the mappings */
-    if (bits != 8 && bits != 16 && bits != 32) {
-       Perl_croak(aTHX_ "panic: swash_inversion_hash doesn't expect bits %"
-                         UVuf, (UV)bits);
-    }
-
-    if (specials_p) { /* It might be "special" (sometimes, but not always, a
-                       mapping to more than one character */
-
-       /* Construct an inverse mapping hash for the specials */
-       HV * const specials_hv = MUTABLE_HV(SvRV(*specials_p));
-       HV * specials_inverse = newHV();
-       char *char_from; /* the lhs of the map */
-       I32 from_len;   /* its byte length */
-       char *char_to;  /* the rhs of the map */
-       I32 to_len;     /* its byte length */
-       SV *sv_to;      /* and in a sv */
-       AV* from_list;  /* list of things that map to each 'to' */
-
-       hv_iterinit(specials_hv);
-
-       /* The keys are the characters (in UTF-8) that map to the corresponding
-        * UTF-8 string value.  Iterate through the list creating the inverse
-        * list. */
-       while ((sv_to = hv_iternextsv(specials_hv, &char_from, &from_len))) {
-           SV** listp;
-           if (! SvPOK(sv_to)) {
-               Perl_croak(aTHX_ "panic: value returned from hv_iternextsv() "
-                          "unexpectedly is not a string, flags=%lu",
-                          (unsigned long)SvFLAGS(sv_to));
-           }
-           /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Found mapping from %" UVXf ", First char of to is %" UVXf "\n", valid_utf8_to_uvchr((U8*) char_from, 0), valid_utf8_to_uvchr((U8*) SvPVX(sv_to), 0)));*/
-
-           /* Each key in the inverse list is a mapped-to value, and the key's
-            * hash value is a list of the strings (each in UTF-8) that map to
-            * it.  Those strings are all one character long */
-           if ((listp = hv_fetch(specials_inverse,
-                                   SvPVX(sv_to),
-                                   SvCUR(sv_to), 0)))
-           {
-               from_list = (AV*) *listp;
-           }
-           else { /* No entry yet for it: create one */
-               from_list = newAV();
-               if (! hv_store(specials_inverse,
-                               SvPVX(sv_to),
-                               SvCUR(sv_to),
-                               (SV*) from_list, 0))
-               {
-                   Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
-               }
-           }
-
-           /* Here have the list associated with this 'to' (perhaps newly
-            * created and empty).  Just add to it.  Note that we ASSUME that
-            * the input is guaranteed to not have duplications, so we don't
-            * check for that.  Duplications just slow down execution time. */
-           av_push(from_list, newSVpvn_utf8(char_from, from_len, TRUE));
-       }
-
-       /* Here, 'specials_inverse' contains the inverse mapping.  Go through
-        * it looking for cases like the FB05/FB06 examples above.  There would
-        * be an entry in the hash like
-       *       'st' => [ FB05, FB06 ]
-       * In this example we will create two lists that get stored in the
-       * returned hash, 'ret':
-       *       FB05 => [ FB05, FB06 ]
-       *       FB06 => [ FB05, FB06 ]
-       *
-       * Note that there is nothing to do if the array only has one element.
-       * (In the normal 1-1 case handled below, we don't have to worry about
-       * two lists, as everything gets tied to the single list that is
-       * generated for the single character 'to'.  But here, we are omitting
-       * that list, ('st' in the example), so must have multiple lists.) */
-       while ((from_list = (AV *) hv_iternextsv(specials_inverse,
-                                                &char_to, &to_len)))
-       {
-           if (av_tindex_skip_len_mg(from_list) > 0) {
-               SSize_t i;
-
-               /* We iterate over all combinations of i,j to place each code
-                * point on each list */
-               for (i = 0; i <= av_tindex_skip_len_mg(from_list); i++) {
-                   SSize_t j;
-                   AV* i_list = newAV();
-                   SV** entryp = av_fetch(from_list, i, FALSE);
-                   if (entryp == NULL) {
-                       Perl_croak(aTHX_ "panic: av_fetch() unexpectedly"
-                                         " failed");
-                   }
-                   if (hv_fetch(ret, SvPVX(*entryp), SvCUR(*entryp), FALSE)) {
-                       Perl_croak(aTHX_ "panic: unexpected entry for %s",
-                                                                SvPVX(*entryp));
-                   }
-                   if (! hv_store(ret, SvPVX(*entryp), SvCUR(*entryp),
-                                  (SV*) i_list, FALSE))
-                   {
-                       Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
-                   }
-
-                   /* For DEBUG_U: UV u = valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0);*/
-                   for (j = 0; j <= av_tindex_skip_len_mg(from_list); j++) {
-                       entryp = av_fetch(from_list, j, FALSE);
-                       if (entryp == NULL) {
-                           Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");
-                       }
-
-                       /* When i==j this adds itself to the list */
-                       av_push(i_list, newSVuv(utf8_to_uvchr_buf(
-                                       (U8*) SvPVX(*entryp),
-                                       (U8*) SvPVX(*entryp) + SvCUR(*entryp),
-                                       0)));
-                       /*DEBUG_U(PerlIO_printf(Perl_debug_log, "%s: %d: Adding %" UVXf " to list for %" UVXf "\n", __FILE__, __LINE__, valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0), u));*/
-                   }
-               }
-           }
-       }
-       SvREFCNT_dec(specials_inverse); /* done with it */
-    } /* End of specials */
-
-    /* read $swash->{LIST} */
-
-#if    UNICODE_MAJOR_VERSION   == 3         \
-    && UNICODE_DOT_VERSION     == 0         \
-    && UNICODE_DOT_DOT_VERSION == 1
-
-    /* For this version only U+130 and U+131 are equivalent under qr//i.  Add a
-     * rule so that things work under /iaa and /il */
-
-    SV * mod_listsv = sv_mortalcopy(*listsvp);
-    sv_catpv(mod_listsv, "130\t130\t131\n");
-    l = (U8*)SvPV(mod_listsv, lcur);
-
-#else
-
-    l = (U8*)SvPV(*listsvp, lcur);
-
-#endif
-
-    lend = l + lcur;
-
-    /* Go through each input line */
-    while (l < lend) {
-       UV min, max, val;
-       UV inverse;
-       l = swash_scan_list_line(l, lend, &min, &max, &val,
-                                                     cBOOL(octets), typestr);
-       if (l > lend) {
-           break;
-       }
-
-       /* Each element in the range is to be inverted */
-       for (inverse = min; inverse <= max; inverse++) {
-           AV* list;
-           SV** listp;
-           IV i;
-           bool found_key = FALSE;
-           bool found_inverse = FALSE;
-
-           /* The key is the inverse mapping */
-           char key[UTF8_MAXBYTES+1];
-           char* key_end = (char *) uvchr_to_utf8((U8*) key, val);
-           STRLEN key_len = key_end - key;
-
-           /* Get the list for the map */
-           if ((listp = hv_fetch(ret, key, key_len, FALSE))) {
-               list = (AV*) *listp;
-           }
-           else { /* No entry yet for it: create one */
-               list = newAV();
-               if (! hv_store(ret, key, key_len, (SV*) list, FALSE)) {
-                   Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
-               }
-           }
-
-           /* Look through list to see if this inverse mapping already is
-            * listed, or if there is a mapping to itself already */
-           for (i = 0; i <= av_tindex_skip_len_mg(list); i++) {
-               SV** entryp = av_fetch(list, i, FALSE);
-               SV* entry;
-               UV uv;
-               if (entryp == NULL) {
-                   Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");
-               }
-               entry = *entryp;
-               uv = SvUV(entry);
-               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "list for %" UVXf " contains %" UVXf "\n", val, uv));*/
-               if (uv == val) {
-                   found_key = TRUE;
-               }
-               if (uv == inverse) {
-                   found_inverse = TRUE;
-               }
-
-               /* No need to continue searching if found everything we are
-                * looking for */
-               if (found_key && found_inverse) {
-                   break;
-               }
-           }
-
-           /* Make sure there is a mapping to itself on the list */
-           if (! found_key) {
-               av_push(list, newSVuv(val));
-               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "%s: %d: Adding %" UVXf " to list for %" UVXf "\n", __FILE__, __LINE__, val, val));*/
-           }
-
-
-           /* Simply add the value to the list */
-           if (! found_inverse) {
-               av_push(list, newSVuv(inverse));
-               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "%s: %d: Adding %" UVXf " to list for %" UVXf "\n", __FILE__, __LINE__, inverse, val));*/
-           }
-
-           /* swatch_get() increments the value of val for each element in the
-            * range.  That makes more compact tables possible.  You can
-            * express the capitalization, for example, of all consecutive
-            * letters with a single line: 0061\t007A\t0041 This maps 0061 to
-            * 0041, 0062 to 0042, etc.  I (khw) have never understood 'none',
-            * and it's not documented; it appears to be used only in
-            * implementing tr//; I copied the semantics from swatch_get(), just
-            * in case */
-           if (!none || val < none) {
-               ++val;
-           }
-       }
-    }
-
-    SvREFCNT_dec(swash);
-
-    return ret;
-}
-
 SV*
 Perl__swash_to_invlist(pTHX_ SV* const swash)
 {
 SV*
 Perl__swash_to_invlist(pTHX_ SV* const swash)
 {