This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove utf8_heavy.pl
authorKarl Williamson <khw@cpan.org>
Wed, 6 Nov 2019 16:40:11 +0000 (09:40 -0700)
committerKarl Williamson <khw@cpan.org>
Thu, 7 Nov 2019 04:22:25 +0000 (21:22 -0700)
The only remaining user of this is Unicode::UCD, and so most of the code
from utf8_heavy.pl is moved into that UCD.pm.

It removes a no-longer relevant test (that had been changed into a skip
anyway), and it changes or removes the no-longer relevant references in
comments to utf8_heavy.pl

Later commits will do some simplification as not all the previous
functionality is needed.  This commit removed only the parts that were
preventing compilation and tests passing.

12 files changed:
MANIFEST
Porting/Maintainers.pl
charclass_invlists.h
lib/Unicode/UCD.pm
lib/Unicode/UCD.t
lib/unicore/mktables
lib/unicore/uni_keywords.pl
lib/utf8_heavy.pl [deleted file]
regcharclass.h
regcomp.c
t/re/pat.t
uni_keywords.h

index f9c9303..cca60a1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4895,7 +4895,6 @@ lib/User/pwent.pm         By-name interface to Perl's builtin getpw*
 lib/User/pwent.t               See if User::pwent works
 lib/utf8.pm                    Pragma to control Unicode support
 lib/utf8.t                     See if utf8 operations work
-lib/utf8_heavy.pl              Support routines for utf8 pragma
 lib/vars.pm                    Declare pseudo-imported global variables
 lib/vars.t                     See if "use vars" works
 lib/vars_carp.t                        See if "use vars" doesn't load Carp.pm per default
index 68b6fa6..330950a 100755 (executable)
@@ -1417,7 +1417,6 @@ use File::Glob qw(:case);
                 lib/subs.{pm,t}
                 lib/unicore/
                 lib/utf8.{pm,t}
-                lib/utf8_heavy.pl
                 lib/vars{.pm,.t,_carp.t}
                 lib/vmsish.{pm,t}
                 ],
index 2d78277..4d86d86 100644 (file)
@@ -395261,7 +395261,7 @@ static const U8 WB_table[23][23] = {
 #define MAX_FOLD_FROMS 3
 
 /* Generated from:
- * 73902d92e2f05c2b707351006727708a3dc043d118f05aee169f70c117489d61 lib/Unicode/UCD.pm
+ * 486ed9a6bcca738e67b88da8199ebc831063808044dc1d0ea98b494ab59ee34a lib/Unicode/UCD.pm
  * 5e91b649379ec79af7cfb6b09410a24557cba4c6d733cd0a2b8a78a1448736d2 lib/unicore/ArabicShaping.txt
  * f5feb19cd084b2b1568fbc0f94f4b4b54941406e7fb36c7570f8352fd5022dbe lib/unicore/BidiBrackets.txt
  * e6cbd8ffe94f2e0fbfa6695d6c06c1e72eef7d3aa93cb6329d111285198b5e62 lib/unicore/BidiMirroring.txt
@@ -395307,7 +395307,7 @@ static const U8 WB_table[23][23] = {
  * 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
  * 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
  * 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
- * ad9f9ebb4ad5378ccb7437b0d15b213b3f9d1b7e5c095284a44bee5d84206be6 lib/unicore/mktables
+ * 74dc5134f7e509239e1b3c8af319df951d1f41f917eceae9bd113c6740a613e6 lib/unicore/mktables
  * a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
  * e9283c761c5a95e3379384ca47c13a284f08d743c2be6e5091f1152b1b6b7a37 regen/mk_PL_charclass.pl
index 115faa9..58d0a14 100644 (file)
@@ -5,7 +5,10 @@ use warnings;
 no warnings 'surrogate';    # surrogates can be inputs to this
 use charnames ();
 
-our $VERSION = '0.73';
+our $VERSION = '0.74';
+
+sub DEBUG () { 0 }
+$|=1 if DEBUG;
 
 require Exporter;
 
@@ -198,7 +201,7 @@ the standard),
 C<undef> is returned.
 
 Fields that aren't applicable to the particular code point argument exist in the
-returned hash, and are empty. 
+returned hash, and are empty.
 
 For results that are less "raw" than this function returns, or to get the values for
 any property, not just the few covered by this function, use the
@@ -344,6 +347,585 @@ L<Unicode::Normalize> module.)
 
 =cut
 
+my %Cache;
+
+# Digits may be separated by a single underscore
+my $digits = qr/ ( [0-9] _? )+ (?!:_) /x;
+
+# A sign can be surrounded by white space
+my $sign = qr/ \s* [+-]? \s* /x;
+
+my $f_float = qr/  $sign $digits+ \. $digits*    # e.g., 5.0, 5.
+                 | $sign $digits* \. $digits+/x; # 0.7, .7
+
+# A number may be an integer, a rational, or a float with an optional exponent
+# We (shudder) accept a signed denominator
+my $number = qr{  ^ $sign $digits+ $
+                | ^ $sign $digits+ \/ $sign $digits+ $
+                | ^ $f_float (?: [Ee] [+-]? $digits )? $}x;
+
+sub loose_name ($) {
+    # Given a lowercase property or property-value name, return its
+    # standardized version that is expected for look-up in the 'loose' hashes
+    # in Heavy.pl (hence, this depends on what mktables does).  This squeezes
+    # out blanks, underscores and dashes.  The complication stems from the
+    # grandfathered-in 'L_', which retains a single trailing underscore.
+
+# integer or float (no exponent)
+my $integer_or_float_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;
+
+# Also includes rationals
+my $numeric_re = qr! $integer_or_float_re | ^ -? \d+ / \d+ $ !x;
+    return $_[0] if $_[0] =~ $numeric_re;
+
+    (my $loose = $_[0]) =~ s/[-_ \t]//g;
+
+    return $loose if $loose !~ / ^ (?: is | to )? l $/x;
+    return 'l_' if $_[0] =~ / l .* _ /x;    # If original had a trailing '_'
+    return $loose;
+}
+
+##
+## "SWASH" == "SWATCH HASH". A "swatch" is a swatch of the Unicode landscape.
+## It's a data structure that encodes a set of Unicode characters.
+##
+
+{
+    use re "/aa";  # Nothing here uses above Latin1.
+
+    # If a floating point number is within this distance from the value of a
+    # fraction, it is considered to be that fraction, even if many more digits
+    # are specified that don't exactly match.
+    my $min_floating_slop;
+
+    # To guard against this program calling something that in turn ends up
+    # calling this program with the same inputs, and hence infinitely
+    # recursing, we keep a stack of the properties that are currently in
+    # progress, pushed upon entry, popped upon return.
+    my @recursed;
+
+    sub SWASHNEW {
+        my ($class, $type, $list, $minbits, $none) = @_;
+        my $user_defined = 0;
+        local $^D = 0 if $^D;
+
+        $class = "" unless defined $class;
+        print STDERR __LINE__, ": class=$class, type=$type, list=",
+                                (defined $list) ? $list : ':undef:',
+                                ", minbits=$minbits, none=$none\n" if DEBUG;
+
+        ##
+        ## Get the list of codepoints for the type.
+        ## Called from swash_init (see utf8.c) or SWASHNEW itself.
+        ##
+        ## Callers of swash_init:
+        ##     Unicode::UCD::prop_invlist
+        ##     Unicode::UCD::prop_invmap
+        ##
+        ## Given a $type, our goal is to fill $list with the set of codepoint
+        ## ranges. If $type is false, $list passed is used.
+        ##
+        ## $minbits:
+        ##     For binary properties, $minbits must be 1.
+        ##     For character mappings (case and transliteration), $minbits must
+        ##     be a number except 1.
+        ##
+        ## $list (or that filled according to $type):
+        ##     Refer to perlunicode.pod, "User-Defined Character Properties."
+        ##
+        ##     For binary properties, only characters with the property value
+        ##     of True should be listed. The 3rd column, if any, will be ignored
+        ##
+        ## $none is undocumented, and unused
+        ##
+        ## To make the parsing of $type clear, this code takes the a rather
+        ## unorthodox approach of last'ing out of the block once we have the
+        ## info we need. Were this to be a subroutine, the 'last' would just
+        ## be a 'return'.
+        ##
+        #   If a problem is found $type is returned;
+        #   Upon success, a new (or cached) blessed object is returned with
+        #   keys TYPE, BITS, EXTRAS, LIST, and NONE with values having the
+        #   same meanings as the input parameters.
+        #   SPECIALS contains a reference to any special-treatment hash in the
+        #       property.
+        #   INVERT_IT is non-zero if the result should be inverted before use
+        #   USER_DEFINED is non-zero if the result came from a user-defined
+        my $file; ## file to load data from, and also part of the %Cache key.
+
+        # Change this to get a different set of Unicode tables
+        my $unicore_dir = 'unicore';
+        my $invert_it = 0;
+        my $list_is_from_mktables = 0;  # Is $list returned from a mktables
+                                        # generated file?  If so, we know it's
+                                        # well behaved.
+
+        if ($type)
+        {
+            # Verify that this isn't a recursive call for this property.
+            # Can't use croak, as it may try to recurse to here itself.
+            my $class_type = $class . "::$type";
+            if (grep { $_ eq $class_type } @recursed) {
+                CORE::die "panic: Infinite recursion in SWASHNEW for '$type'\n";
+            }
+            push @recursed, $class_type;
+
+            $type =~ s/^\s+//;
+            $type =~ s/\s+$//;
+
+            # regcomp.c surrounds the property name with '__" and '_i' if this
+            # is to be caseless matching.
+            my $caseless = $type =~ s/^(.*)__(.*)_i$/$1$2/;
+
+            print STDERR __LINE__, ": type=$type, caseless=$caseless\n" if DEBUG;
+
+        GETFILE:
+            {
+                ##
+                ## It could be a user-defined property.  Look in current
+                ## package if no package given
+                ##
+
+
+                my $caller0 = caller(0);
+                my $caller1 = $type =~ s/(.+):://
+                              ? $1
+                              : $caller0 eq 'main'
+                                ? 'main'
+                                : caller(1);
+
+                if (defined $caller1 && $type =~ /^I[ns]\w+$/) {
+                    my $prop = "${caller1}::$type";
+                    if (exists &{$prop}) {
+                        # stolen from Scalar::Util::PP::tainted()
+                        my $tainted;
+                        {
+                            local($@, $SIG{__DIE__}, $SIG{__WARN__});
+                            local $^W = 0;
+                            no warnings;
+                            eval { kill 0 * $prop };
+                            $tainted = 1 if $@ =~ /^Insecure/;
+                        }
+                        die "Insecure user-defined property \\p{$prop}\n"
+                            if $tainted;
+                        no strict 'refs';
+                        $list = &{$prop}($caseless);
+                        $user_defined = 1;
+                        last GETFILE;
+                    }
+                }
+
+                require "$unicore_dir/Heavy.pl";
+
+                # All property names are matched caselessly
+                my $property_and_table = CORE::lc $type;
+                print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
+
+                # See if is of the compound form 'property=value', where the
+                # value indicates the table we should use.
+                my ($property, $table, @remainder) =
+                                    split /\s*[:=]\s*/, $property_and_table, -1;
+                if (@remainder) {
+                    pop @recursed if @recursed;
+                    return $type;
+                }
+
+                my $prefix;
+                if (! defined $table) {
+
+                    # Here, is the single form.  The property becomes empty, and
+                    # the whole value is the table.
+                    $table = $property;
+                    $prefix = $property = "";
+                } else {
+                    print STDERR __LINE__, ": $property\n" if DEBUG;
+
+                    # Here it is the compound property=table form.  The property
+                    # name is always loosely matched, and always can have an
+                    # optional 'is' prefix (which isn't true in the single
+                    # form).
+                    $property = loose_name($property) =~ s/^is//r;
+
+                    # And convert to canonical form.  Quit if not valid.
+                    $property = $utf8::loose_property_name_of{$property};
+                    if (! defined $property) {
+                        pop @recursed if @recursed;
+                        return $type;
+                    }
+
+                    $prefix = "$property=";
+
+                    # If the rhs looks like it is a number...
+                    print STDERR __LINE__, ": table=$table\n" if DEBUG;
+
+                    if ($table =~ $number) {
+                        print STDERR __LINE__, ": table=$table\n" if DEBUG;
+
+                        # Split on slash, in case it is a rational, like \p{1/5}
+                        my @parts = split m{ \s* / \s* }x, $table, -1;
+                        print __LINE__, ": $type\n" if @parts > 2 && DEBUG;
+
+                        foreach my $part (@parts) {
+                            print __LINE__, ": part=$part\n" if DEBUG;
+
+                            $part =~ s/^\+\s*//;    # Remove leading plus
+                            $part =~ s/^-\s*/-/;    # Remove blanks after unary
+                                                    # minus
+
+                            # Remove underscores between digits.
+                            $part =~ s/(?<= [0-9] ) _ (?= [0-9] ) //xg;
+
+                            # No leading zeros (but don't make a single '0'
+                            # into a null string)
+                            $part =~ s/ ^ ( -? ) 0+ /$1/x;
+                            $part .= '0' if $part eq '-' || $part eq "";
+
+                            # No trailing zeros after a decimal point
+                            $part =~ s/ ( \. [0-9]*? ) 0+ $ /$1/x;
+
+                            # Begin with a 0 if a leading decimal point
+                            $part =~ s/ ^ ( -? ) \. /${1}0./x;
+
+                            # Ensure not a trailing decimal point: turn into an
+                            # integer
+                            $part =~ s/ \. $ //x;
+
+                            print STDERR __LINE__, ": part=$part\n" if DEBUG;
+                            #return $type if $part eq "";
+                        }
+
+                        #  If a rational...
+                        if (@parts == 2) {
+
+                            # If denominator is negative, get rid of it, and ...
+                            if ($parts[1] =~ s/^-//) {
+
+                                # If numerator is also negative, convert the
+                                # whole thing to positive, else move the minus
+                                # to the numerator
+                                if ($parts[0] !~ s/^-//) {
+                                    $parts[0] = '-' . $parts[0];
+                                }
+                            }
+                            $table = join '/', @parts;
+                        }
+                        elsif ($property ne 'nv' || $parts[0] !~ /\./) {
+
+                            # Here is not numeric value, or doesn't have a
+                            # decimal point.  No further manipulation is
+                            # necessary.  (Note the hard-coded property name.
+                            # This could fail if other properties eventually
+                            # had fractions as well; perhaps the cjk ones
+                            # could evolve to do that.  This hard-coding could
+                            # be fixed by mktables generating a list of
+                            # properties that could have fractions.)
+                            $table = $parts[0];
+                        } else {
+
+                            # Here is a floating point numeric_value.  Convert
+                            # to rational.  Get a normalized form, like
+                            # 5.00E-01, and look that up in the hash
+
+                            my $float = sprintf "%.*e",
+                                                $utf8::e_precision,
+                                                0 + $parts[0];
+
+                            if (exists $utf8::nv_floating_to_rational{$float}) {
+                                $table = $utf8::nv_floating_to_rational{$float};
+                            } else {
+                                pop @recursed if @recursed;
+                                return $type;
+                            }
+                        }
+                        print STDERR __LINE__, ": $property=$table\n" if DEBUG;
+                    }
+                }
+
+                # Combine lhs (if any) and rhs to get something that matches
+                # the syntax of the lookups.
+                $property_and_table = "$prefix$table";
+                print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
+
+                # First try stricter matching.
+                $file = $utf8::stricter_to_file_of{$property_and_table};
+
+                # If didn't find it, try again with looser matching by editing
+                # out the applicable characters on the rhs and looking up
+                # again.
+                my $strict_property_and_table;
+                if (! defined $file) {
+
+                    # This isn't used unless the name begins with 'to'
+                    $strict_property_and_table = $property_and_table =~  s/^to//r;
+                    $table = loose_name($table);
+                    $property_and_table = "$prefix$table";
+                    print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
+                    $file = $utf8::loose_to_file_of{$property_and_table};
+                }
+
+                # Add the constant and go fetch it in.
+                if (defined $file) {
+
+                    # If the file name contains a !, it means to invert.  The
+                    # 0+ makes sure result is numeric
+                    $invert_it = 0 + $file =~ s/!//;
+
+                    if ($caseless
+                        && exists $utf8::caseless_equivalent{$property_and_table})
+                    {
+                        $file = $utf8::caseless_equivalent{$property_and_table};
+                    }
+
+                    # The pseudo-directory '#' means that there really isn't a
+                    # file to read, the data is in-line as part of the string;
+                    # we extract it below.
+                    $file = "$unicore_dir/lib/$file.pl" unless $file =~ m!^#/!;
+                    last GETFILE;
+                }
+                print STDERR __LINE__, ": didn't find $property_and_table\n" if DEBUG;
+
+                ##
+                ## Last attempt -- see if it's a standard "To" name
+                ## (e.g. "ToLower")  ToTitle is used by ucfirst().
+                ## The user-level way to access ToDigit() and ToFold()
+                ## is to use Unicode::UCD.
+                ##
+                # Only check if caller wants non-binary
+                if ($minbits != 1) {
+                    if ($property_and_table =~ s/^to//) {
+                    # Look input up in list of properties for which we have
+                    # mapping files.  First do it with the strict approach
+                        if (defined ($file = $utf8::strict_property_to_file_of{
+                                                    $strict_property_and_table}))
+                        {
+                            $type = $utf8::file_to_swash_name{$file};
+                            print STDERR __LINE__, ": type set to $type\n"
+                                                                        if DEBUG;
+                            $file = "$unicore_dir/$file.pl";
+                            last GETFILE;
+                        }
+                        elsif (defined ($file =
+                          $utf8::loose_property_to_file_of{$property_and_table}))
+                        {
+                            $type = $utf8::file_to_swash_name{$file};
+                            print STDERR __LINE__, ": type set to $type\n"
+                                                                        if DEBUG;
+                            $file = "$unicore_dir/$file.pl";
+                            last GETFILE;
+                        }   # If that fails see if there is a corresponding binary
+                            # property file
+                        elsif (defined ($file =
+                                    $utf8::loose_to_file_of{$property_and_table}))
+                        {
+
+                            # Here, there is no map file for the property we
+                            # are trying to get the map of, but this is a
+                            # binary property, and there is a file for it that
+                            # can easily be translated to a mapping, so use
+                            # that, treating this as a binary property.
+                            # Setting 'minbits' here causes it to be stored as
+                            # such in the cache, so if someone comes along
+                            # later looking for just a binary, they get it.
+                            $minbits = 1;
+
+                            # The 0+ makes sure is numeric
+                            $invert_it = 0 + $file =~ s/!//;
+                            $file = "$unicore_dir/lib/$file.pl"
+                                                         unless $file =~ m!^#/!;
+                            last GETFILE;
+                        }
+                    }
+                }
+
+                ##
+                ## If we reach this line, it's because we couldn't figure
+                ## out what to do with $type. Ouch.
+                ##
+
+                pop @recursed if @recursed;
+                return $type;
+            } # end of GETFILE block
+
+            if (defined $file) {
+                print STDERR __LINE__, ": found it (file='$file')\n" if DEBUG;
+
+                ##
+                ## If we reach here, it was due to a 'last GETFILE' above
+                ## (exception: user-defined properties and mappings), so we
+                ## have a filename, so now we load it if we haven't already.
+
+                # The pseudo-directory '#' means the result isn't really a
+                # file, but is in-line, with semi-colons to be turned into
+                # new-lines.  Since it is in-line there is no advantage to
+                # caching the result
+                if ($file =~ s!^#/!!) {
+                    $list = $utf8::inline_definitions[$file];
+                }
+                else {
+                    # Here, we have an actual file to read in and load, but it
+                    # may already have been read-in and cached.  The cache key
+                    # is the class and file to load, and whether the results
+                    # need to be inverted.
+                    my $found = $Cache{$class, $file, $invert_it};
+                    if ($found and ref($found) eq $class) {
+                        print STDERR __LINE__, ": Returning cached swash for '$class,$file,$invert_it' for \\p{$type}\n" if DEBUG;
+                        pop @recursed if @recursed;
+                        return $found;
+                    }
+
+                    local $@;
+                    local $!;
+                    $list = do $file; die $@ if $@;
+                }
+
+                $list_is_from_mktables = 1;
+            }
+        } # End of $type is non-null
+
+        # Here, either $type was null, or we found the requested property and
+        # read it into $list
+
+        my $extras = "";
+
+        my $bits = $minbits;
+
+        # mktables lists don't have extras, like '&utf8::prop', so don't need
+        # to separate them; also lists are already sorted, so don't need to do
+        # that.
+        if ($list && ! $list_is_from_mktables) {
+            my $taint = substr($list,0,0); # maintain taint
+
+            # Separate the extras from the code point list, and make sure
+            # user-defined properties are well-behaved for
+            # downstream code.
+            if ($user_defined || $none) {
+                my @tmp = split(/^/m, $list);
+                my %seen;
+                no warnings;
+
+                # The extras are anything that doesn't begin with a hex digit.
+                $extras = join '', $taint, grep /^[^0-9a-fA-F]/, @tmp;
+
+                # Remove the extras, and sort the remaining entries by the
+                # numeric value of their beginning hex digits, removing any
+                # duplicates.
+                $list = join '', $taint,
+                        map  { $_->[1] }
+                        sort { $a->[0] <=> $b->[0] }
+                        map  { /^([0-9a-fA-F]+)/ && !$seen{$1}++ ? [ CORE::hex($1), $_ ] : () }
+                        @tmp; # XXX doesn't do ranges right
+            }
+            else {
+                # mktables has gone to some trouble to make non-user defined
+                # properties well-behaved, so we can skip the effort we do for
+                # user-defined ones.  Any extras are at the very beginning of
+                # the string.
+
+                # This regex splits out the first lines of $list into $1 and
+                # strips them off from $list, until we get one that begins
+                # with a hex number, alone on the line, or followed by a tab.
+                # Either portion may be empty.
+                $list =~ s/ \A ( .*? )
+                            (?: \z | (?= ^ [0-9a-fA-F]+ (?: \t | $) ) )
+                          //msx;
+
+                $extras = "$taint$1";
+            }
+        }
+
+        if ($none) {
+            my $hextra = sprintf "%04x", $none + 1;
+            $list =~ s/\tXXXX$/\t$hextra/mg;
+        }
+
+        if ($minbits != 1 && $minbits < 32) { # not binary property
+            my $top = 0;
+            while ($list =~ /^([0-9a-fA-F]+)(?:[\t]([0-9a-fA-F]+)?)(?:[ \t]([0-9a-fA-F]+))?/mg) {
+                my $min = CORE::hex $1;
+                my $max = defined $2 ? CORE::hex $2 : $min;
+                my $val = defined $3 ? CORE::hex $3 : 0;
+                $val += $max - $min if defined $3;
+                $top = $val if $val > $top;
+            }
+            my $topbits =
+                $top > 0xffff ? 32 :
+                $top > 0xff ? 16 : 8;
+            $bits = $topbits if $bits < $topbits;
+        }
+
+        my @extras;
+        if ($extras) {
+            for my $x ($extras) {
+                my $taint = substr($x,0,0); # maintain taint
+                pos $x = 0;
+                while ($x =~ /^([^0-9a-fA-F\n])(.*)/mg) {
+                    my $char = "$1$taint";
+                    my $name = "$2$taint";
+                    print STDERR __LINE__, ": char [$char] => name [$name]\n"
+                        if DEBUG;
+                    if ($char =~ /[-+!&]/) {
+                        my ($c,$t) = split(/::/, $name, 2);    # bogus use of ::, really
+                        my $subobj;
+                        if ($c eq 'utf8') {
+                            $subobj = SWASHNEW($t, "", $minbits, 0);
+                        }
+                        elsif (exists &$name) {
+                            $subobj = SWASHNEW($name, "", $minbits, 0);
+                        }
+                        elsif ($c =~ /^([0-9a-fA-F]+)/) {
+                            $subobj = SWASHNEW("", $c, $minbits, 0);
+                        }
+                        print STDERR __LINE__, ": returned from getting sub object for $name\n" if DEBUG;
+                        if (! ref $subobj) {
+                            pop @recursed if @recursed && $type;
+                            return $subobj;
+                        }
+                        push @extras, $name => $subobj;
+                        $bits = $subobj->{BITS} if $bits < $subobj->{BITS};
+                        $user_defined = $subobj->{USER_DEFINED}
+                                              if $subobj->{USER_DEFINED};
+                    }
+                }
+            }
+        }
+
+        if (DEBUG) {
+            print STDERR __LINE__, ": CLASS = $class, TYPE => $type, BITS => $bits, NONE => $none, INVERT_IT => $invert_it, USER_DEFINED => $user_defined";
+            print STDERR "\nLIST =>\n$list" if defined $list;
+            print STDERR "\nEXTRAS =>\n$extras" if defined $extras;
+            print STDERR "\n";
+        }
+
+        my $SWASH = bless {
+            TYPE => $type,
+            BITS => $bits,
+            EXTRAS => $extras,
+            LIST => $list,
+            NONE => $none,
+            USER_DEFINED => $user_defined,
+            @extras,
+        } => $class;
+
+        if ($file) {
+            $Cache{$class, $file, $invert_it} = $SWASH;
+            if ($type
+                && exists $utf8::SwashInfo{$type}
+                && exists $utf8::SwashInfo{$type}{'specials_name'})
+            {
+                my $specials_name = $utf8::SwashInfo{$type}{'specials_name'};
+                no strict "refs";
+                print STDERR "\nspecials_name => $specials_name\n" if DEBUG;
+                $SWASH->{'SPECIALS'} = \%$specials_name;
+            }
+            $SWASH->{'INVERT_IT'} = $invert_it;
+        }
+
+        pop @recursed if @recursed && $type;
+
+        return $SWASH;
+    }
+}
+
 # NB: This function is nearly duplicated in charnames.pm
 sub _getcode {
     my $arg = shift;
@@ -409,7 +991,7 @@ sub charinfo {
     @CATEGORIES =_read_table("To/Gc.pl") unless @CATEGORIES;
     $prop{'category'} = _search(\@CATEGORIES, 0, $#CATEGORIES, $code)
                         // $utf8::SwashInfo{'ToGc'}{'missing'};
-    # Return undef if category value is 'Unassigned' or one of its synonyms 
+    # Return undef if category value is 'Unassigned' or one of its synonyms
     return if grep { lc $_ eq 'unassigned' }
                                     prop_value_aliases('Gc', $prop{'category'});
 
@@ -728,7 +1310,7 @@ sub charprop ($$;$) {
             # extensions.  But this is misleading.  For now, return undef for
             # these, as currently documented.
             undef $map unless
-                exists $Unicode::UCD::prop_aliases{utf8::_loose_name(lc $prop)};
+                exists $Unicode::UCD::prop_aliases{loose_name(lc $prop)};
         }
         return $map;
     }
@@ -1168,7 +1750,7 @@ my %BIDI_TYPES =
    'S'   => 'Segment Separator',
    'WS'  => 'Whitespace',
    'ON'  => 'Other Neutrals',
- ); 
+ );
 
 =head2 B<bidi_types()>
 
@@ -1361,7 +1943,7 @@ additional processing.
 For Unicode versions between 3.1 and 3.1.1 inclusive, this field is empty unless
 there is a
 special folding for Turkic languages, in which case I<status> is C<I>, and
-I<mapping>, I<full>, I<simple>, and I<turkic> are all equal.  
+I<mapping>, I<full>, I<simple>, and I<turkic> are all equal.
 
 =back
 
@@ -2075,7 +2657,6 @@ sub prop_aliases ($) {
 
     require "unicore/UCD.pl";
     require "unicore/Heavy.pl";
-    require "utf8_heavy.pl";
 
     # The property name may be loosely or strictly matched; we don't know yet.
     # But both types use lower-case.
@@ -2084,19 +2665,19 @@ sub prop_aliases ($) {
     # It is loosely matched if its lower case isn't known to be strict.
     my $list_ref;
     if (! exists $utf8::stricter_to_file_of{$prop}) {
-        my $loose = utf8::_loose_name($prop);
+        my $loose = loose_name($prop);
 
         # There is a hash that converts from any loose name to its standard
         # form, mapping all synonyms for a  name to one name that can be used
         # as a key into another hash.  The whole concept is for memory
         # savings, as the second hash doesn't have to have all the
         # combinations.  Actually, there are two hashes that do the
-        # conversion.  One is used in utf8_heavy.pl (stored in Heavy.pl) for
-        # looking up properties matchable in regexes.  This function needs to
-        # access string properties, which aren't available in regexes, so a
-        # second conversion hash is made for them (stored in UCD.pl).  Look in
-        # the string one now, as the rest can have an optional 'is' prefix,
-        # which these don't.
+        # conversion.  One is stored in Heavy.pl) for looking up properties
+        # matchable in regexes.  This function needs to access string
+        # properties, which aren't available in regexes, so a second
+        # conversion hash is made for them (stored in UCD.pl).  Look in the
+        # string one now, as the rest can have an optional 'is' prefix, which
+        # these don't.
         if (exists $string_property_loose_to_name{$loose}) {
 
             # Convert to its standard loose name.
@@ -2167,7 +2748,7 @@ sub prop_aliases ($) {
                     # if necessary.
                     for my $i (0 .. @list -1) {
                         if (exists $ambiguous_names
-                                   {utf8::_loose_name(lc $list[$i])})
+                                   {loose_name(lc $list[$i])})
                         {
                             # The ambiguity is resolved by toggling whether or
                             # not it has an 'is' prefix
@@ -2282,13 +2863,12 @@ sub prop_values ($) {
     return undef unless defined $prop;
 
     require "unicore/UCD.pl";
-    require "utf8_heavy.pl";
 
     # Find the property name synonym that's used as the key in other hashes,
     # which is element 0 in the returned list.
     ($prop) = prop_aliases($prop);
     return undef if ! $prop;
-    $prop = utf8::_loose_name(lc $prop);
+    $prop = loose_name(lc $prop);
 
     # Here is a legal property.
     return undef unless exists $prop_value_aliases{$prop};
@@ -2372,13 +2952,12 @@ sub prop_value_aliases ($$) {
     return unless defined $prop && defined $value;
 
     require "unicore/UCD.pl";
-    require "utf8_heavy.pl";
 
     # Find the property name synonym that's used as the key in other hashes,
     # which is element 0 in the returned list.
     ($prop) = prop_aliases($prop);
     return if ! $prop;
-    $prop = utf8::_loose_name(lc $prop);
+    $prop = loose_name(lc $prop);
 
     # Here is a legal property, but the hash below (created by mktables for
     # this purpose) only knows about the properties that have a very finite
@@ -2405,7 +2984,7 @@ sub prop_value_aliases ($$) {
 
     # If the name isn't found under loose matching, it certainly won't be
     # found under strict
-    my $loose_value = utf8::_loose_name($value);
+    my $loose_value = loose_name($value);
     return unless exists $loose_to_standard_value{"$prop=$loose_value"};
 
     # Similarly if the combination under loose matching doesn't exist, it
@@ -2561,7 +3140,7 @@ an inversion list.
 
 =cut
 
-# User-defined properties could be handled with some changes to utf8_heavy.pl;
+# User-defined properties could be handled with some changes to SWASHNEW;
 # and implementing here of dealing with EXTRAS.  If done, consideration should
 # be given to the fact that the user subroutine could return different results
 # with each call; security issues need to be thought about.
@@ -2580,13 +3159,11 @@ sub prop_invlist ($;$) {
 
     return if ! defined $prop;
 
-    require "utf8_heavy.pl";
-
     # Warnings for these are only for regexes, so not applicable to us
     no warnings 'deprecated';
 
     # Get the swash definition of the property-value.
-    my $swash = utf8::SWASHNEW(__PACKAGE__, $prop, undef, 1, 0);
+    my $swash = SWASHNEW(__PACKAGE__, $prop, undef, 1, 0);
 
     # Fail if not found, or isn't a boolean property-value, or is a
     # user-defined property, or is internal-only.
@@ -3205,7 +3782,7 @@ You ought to use L</prop_invmap()> like this:
 
 =cut
 
-# User-defined properties could be handled with some changes to utf8_heavy.pl;
+# User-defined properties could be handled with some changes to SWASHNEW;
 # if done, consideration should be given to the fact that the user subroutine
 # could return different results with each call, which could lead to some
 # security issues.
@@ -3245,7 +3822,6 @@ sub prop_invmap ($;$) {
     # any value in the base list for the same code point.
     my $overrides;
 
-    require "utf8_heavy.pl";
     require "unicore/UCD.pl";
 
 RETRY:
@@ -3256,7 +3832,7 @@ RETRY:
     # Try to get the map swash for the property.  They have 'To' prepended to
     # the property name, and 32 means we will accept 32 bit return values.
     # The 0 means we aren't calling this from tr///.
-    my $swash = utf8::SWASHNEW(__PACKAGE__, "To$prop", undef, 32, 0);
+    my $swash = SWASHNEW(__PACKAGE__, "To$prop", undef, 32, 0);
 
     # If didn't find it, could be because needs a proxy.  And if was the
     # 'Block' or 'Name' property, use a proxy even if did find it.  Finding it
@@ -3273,7 +3849,7 @@ RETRY:
         # Get the short name of the input property, in standard form
         my ($second_try) = prop_aliases($prop);
         return unless $second_try;
-        $second_try = utf8::_loose_name(lc $second_try);
+        $second_try = loose_name(lc $second_try);
 
         if ($second_try eq "in") {
 
index 0880fec..f8e0a7a 100644 (file)
@@ -903,7 +903,6 @@ is(prop_aliases("Is_Is_Any"), undef,
 is(prop_aliases("ccc=vr"), undef,
                           "prop_aliases('ccc=vr') doesn't generate a warning");
 
-require 'utf8_heavy.pl';
 require "unicore/Heavy.pl";
 
 # Keys are lists of properties. Values are defined if have been tested.
@@ -943,7 +942,7 @@ while (<$props>) {
         # matching, which the tested function does on all inputs.
         my $mod_name = "$extra_chars$alias";
 
-        my $loose = &utf8::_loose_name(lc $alias);
+        my $loose = &Unicode::UCD::loose_name(lc $alias);
 
         # Indicate we have tested this.
         $props{$loose} = 1;
@@ -999,12 +998,12 @@ while (<$props>) {
 foreach my $alias (sort keys %utf8::loose_to_file_of) {
     next if $alias =~ /=/;
     my $lc_name = lc $alias;
-    my $loose = &utf8::_loose_name($lc_name);
+    my $loose = &Unicode::UCD::loose_name($lc_name);
     next if exists $props{$loose};  # Skip if already tested
     $props{$loose} = 1;
     my $mod_name = "$extra_chars$alias";    # Tests loose matching
     my @aliases = prop_aliases($mod_name);
-    my $found_it = grep { &utf8::_loose_name(lc $_) eq $lc_name } @aliases;
+    my $found_it = grep { &Unicode::UCD::loose_name(lc $_) eq $lc_name } @aliases;
     if ($found_it) {
         pass("prop_aliases: '$lc_name' is listed as an alias for '$mod_name'");
     }
@@ -1023,14 +1022,14 @@ foreach my $alias (sort keys %utf8::loose_to_file_of) {
         # returned as an alias, so having successfully stripped it off above,
         # try again.
         if ($stripped) {
-            $found_it = grep { &utf8::_loose_name(lc $_) eq $lc_name } @aliases;
+            $found_it = grep { &Unicode::UCD::loose_name(lc $_) eq $lc_name } @aliases;
         }
 
         # If that didn't work, it could be that it's a block, which is always
         # returned with a leading 'In_' to avoid ambiguity.  Try comparing
         # with that stripped off.
         if (! $found_it) {
-            $found_it = grep { &utf8::_loose_name(s/^In_(.*)/\L$1/r) eq $lc_name }
+            $found_it = grep { &Unicode::UCD::loose_name(s/^In_(.*)/\L$1/r) eq $lc_name }
                               @aliases;
             # Could check that is a real block, but tests for invmap will
             # likely pickup any errors, since this will be tested there.
@@ -1163,8 +1162,8 @@ while (<$propvalues>) {
         $fields[0] = $fields[1];
     }
     elsif ($fields[0] ne $fields[1]
-           && &utf8::_loose_name(lc $fields[0])
-               eq &utf8::_loose_name(lc $fields[1])
+           && &Unicode::UCD::loose_name(lc $fields[0])
+               eq &Unicode::UCD::loose_name(lc $fields[1])
            && $fields[1] !~ /[[:upper:]]/)
     {
         # Also, there is a bug in the file in which "n/a" is omitted, and
@@ -1180,7 +1179,7 @@ while (<$propvalues>) {
     # the short and full names, respectively.  See comments in input file.
     splice (@fields, 0, 0, splice(@fields, 1, 2)) if $prop eq 'ccc';
 
-    my $loose_prop = &utf8::_loose_name(lc $prop);
+    my $loose_prop = &Unicode::UCD::loose_name(lc $prop);
     my $suppressed = grep { $_ eq $loose_prop }
                           @Unicode::UCD::suppressed_properties;
     push @this_prop_values, $fields[0] unless $suppressed;
@@ -1189,7 +1188,7 @@ while (<$propvalues>) {
             is(prop_value_aliases($prop, $value), undef, "prop_value_aliases('$prop', '$value') returns undef for suppressed property $prop");
             next;
         }
-        elsif (grep { $_ eq ("$loose_prop=" . &utf8::_loose_name(lc $value)) } @Unicode::UCD::suppressed_properties) {
+        elsif (grep { $_ eq ("$loose_prop=" . &Unicode::UCD::loose_name(lc $value)) } @Unicode::UCD::suppressed_properties) {
             is(prop_value_aliases($prop, $value), undef, "prop_value_aliases('$prop', '$value') returns undef for suppressed property $prop=$value");
             next;
         }
@@ -1231,10 +1230,10 @@ while (<$propvalues>) {
         else {
             my @all_names = prop_value_aliases($mod_prop, $mod_value);
             is_deeply(\@all_names, \@names_via_short, "In '$prop', prop_value_aliases() returns the same list for both '$short_name' and '$mod_value'");
-            ok((grep { &utf8::_loose_name(lc $_) eq &utf8::_loose_name(lc $value) } prop_value_aliases($prop, $short_name)), "'$value' is listed as an alias for prop_value_aliases('$prop', '$short_name')");
+            ok((grep { &Unicode::UCD::loose_name(lc $_) eq &Unicode::UCD::loose_name(lc $value) } prop_value_aliases($prop, $short_name)), "'$value' is listed as an alias for prop_value_aliases('$prop', '$short_name')");
         }
 
-        $pva_tested{&utf8::_loose_name(lc $prop) . "=" . &utf8::_loose_name(lc $value)} = 1;
+        $pva_tested{&Unicode::UCD::loose_name(lc $prop) . "=" . &Unicode::UCD::loose_name(lc $value)} = 1;
         $count++;
     }
 }
@@ -1285,7 +1284,7 @@ foreach my $hash (\%utf8::loose_to_file_of, \%utf8::stricter_to_file_of) {
             is_deeply(\@l_, \@LC, "prop_value_aliases('$mod_prop', '$mod_value) returns the same list as prop_value_aliases('gc', 'lc')");
         }
         else {
-            ok((grep { &utf8::_loose_name(lc $_) eq &utf8::_loose_name(lc $value) }
+            ok((grep { &Unicode::UCD::loose_name(lc $_) eq &Unicode::UCD::loose_name(lc $value) }
                 prop_value_aliases($mod_prop, $mod_value)),
                 "'$value' is listed as an alias for prop_value_aliases('$mod_prop', '$mod_value')");
         }
@@ -1300,7 +1299,7 @@ use Unicode::UCD qw(prop_invlist prop_invmap MAX_CP);
 
 # There were some problems with caching interfering with prop_invlist() vs
 # prop_invmap() on binary properties, and also between the 3 properties where
-# Perl used the same 'To' name as another property (see utf8_heavy.pl).
+# Perl used the same 'To' name as another property (see Unicode::UCD).
 # So, before testing all of prop_invlist(),
 #   1)  call prop_invmap() to try both orders of these name issues.  This uses
 #       up two of the 3 properties;  the third will be left so that invlist()
@@ -1663,7 +1662,7 @@ my %tested_invmaps;
 PROPERTY:
 foreach my $prop (sort(keys %props), sort keys %legacy_props) {
     my $is_legacy = 0;
-    my $loose_prop = &utf8::_loose_name(lc $prop);
+    my $loose_prop = &Unicode::UCD::loose_name(lc $prop);
     my $suppressed = grep { $_ eq $loose_prop }
                           @Unicode::UCD::suppressed_properties;
 
@@ -1713,14 +1712,14 @@ foreach my $prop (sort(keys %props), sort keys %legacy_props) {
 
     # Normalize the short name, as it is stored in the hashes under the
     # normalized version.
-    $name = &utf8::_loose_name(lc $name);
+    $name = &Unicode::UCD::loose_name(lc $name);
 
     # In the case of a combination property, both a map table and a match
     # table are generated.  For all the tests except prop_invmap(), this is
     # irrelevant, but for prop_invmap, having an 'is' prefix forces it to
     # return the match table; otherwise the map.  We thus need to distinguish
     # between the two forms.  The property name is what has this information.
-    $name = &utf8::_loose_name(lc $prop)
+    $name = &Unicode::UCD::loose_name(lc $prop)
                          if exists $Unicode::UCD::combination_property{$name};
 
     # Add in the characters that are supposed to be ignored to test loose
@@ -2712,7 +2711,8 @@ if ($v_unicode_version ge v3.1.0) { # No Script property before this
 
 ok($/ eq $input_record_separator,  "The record separator didn't get overridden");
 
-if (! ok(@warnings == 0, "No warnings were generated")) {
+@warnings = grep { $_ !~ /Use of '.*' in \\p\{} or \\P\{} is deprecated because/ } @warnings;
+if (! ok(@warnings == 0, "The only warnings generated are about deprecated properties")) {
     diag(join "\n", "The warnings are:", @warnings);
 }
 
index 47bf2d3..78d522f 100644 (file)
@@ -145,15 +145,15 @@ my $map_directory = 'To';        # Where map files go.
 # Again, this is so that methods can be defined on one and not the others so
 # as to prevent operating on them in incorrect ways.
 #
-# Eventually, most tables are written out to files to be read by utf8_heavy.pl
-# in the perl core.  All tables could in theory be written, but some are
-# suppressed because there is no current practical use for them.  It is easy
-# to change which get written by changing various lists that are near the top
-# of the actual code in this file.  The table data structures contain enough
-# ancillary information to allow them to be treated as separate entities for
-# writing, such as the path to each one's file.  There is a heading in each
-# map table that gives the format of its entries, and what the map is for all
-# the code points missing from it.  (This allows tables to be more compact.)
+# Eventually, most tables are written out to files to be read by Unicode::UCD.
+# All tables could in theory be written, but some are suppressed because there
+# is no current practical use for them.  It is easy to change which get
+# written by changing various lists that are near the top of the actual code
+# in this file.  The table data structures contain enough ancillary
+# information to allow them to be treated as separate entities for writing,
+# such as the path to each one's file.  There is a heading in each map table
+# that gives the format of its entries, and what the map is for all the code
+# points missing from it.  (This allows tables to be more compact.)
 #
 # The Property data structure contains one or more tables.  All properties
 # contain a map table (except the $perl property which is a
@@ -1322,7 +1322,7 @@ my $EXTRACTED = ($EXTRACTED_DIR) ? "$EXTRACTED_DIR/" : "";
 my $AUXILIARY = 'auxiliary';
 
 # Hashes and arrays that will eventually go into Heavy.pl for the use of
-# utf8_heavy.pl and into UCD.pl for the use of UCD.pm
+# UCD.pl for the use of UCD.pm
 my %loose_to_file_of;       # loosely maps table names to their respective
                             # files
 my %stricter_to_file_of;    # same; but for stricter mapping.
@@ -10044,10 +10044,10 @@ sub standardize ($) {
     return lc $name;
 }
 
-sub utf8_heavy_name ($$) {
-    # Returns the name that utf8_heavy.pl will use to find a table.  XXX
+sub UCD_name ($$) {
+    # Returns the name that Unicode::UCD will use to find a table.  XXX
     # perhaps this function should be placed somewhere, like Heavy.pl so that
-    # utf8_heavy can use it directly without duplicating code that can get
+    # Unicode::UCD can use it directly without duplicating code that can get
     # out-of sync.
 
     my $table = shift;
@@ -12201,7 +12201,7 @@ END
         #       taking the data from Version 2, verified by analyzing
         #       DAge.txt.
         # 3)    There is a syntax error in the entry for U+09F8 which could
-        #       cause problems for utf8_heavy, and so is changed.  It's
+        #       cause problems for Unicode::UCD, and so is changed.  It's
         #       numeric value was simply a minus sign, without any number.
         #       (Eventually Unicode changed the code point to non-numeric.)
         # 4)    The decomposition types often don't match later versions
@@ -12967,7 +12967,7 @@ sub filter_jamo_line {
 
 sub register_fraction($) {
     # This registers the input rational number so that it can be passed on to
-    # utf8_heavy.pl, both in rational and floating forms.
+    # Unicode::UCD, both in rational and floating forms.
 
     my $rational = shift;
 
@@ -13964,7 +13964,7 @@ END
         }
 
         # For Perl 5.6 compatibility, all properties matchable in regexes can
-        # have an optional 'Is_' prefix.  This is now done in utf8_heavy.pl.
+        # have an optional 'Is_' prefix.  This is now done in Unicode::UCD.
         # But warn if this creates a conflict with a (new) Unicode property
         # name, although it appears that Unicode has made a decision never to
         # begin a property name with 'Is_', so this shouldn't happen.
@@ -16029,7 +16029,7 @@ sub register_file_for_name($$$) {
 
         my $file = join '/', @path;
 
-        # Create a hash entry for utf8_heavy to get the file that stores this
+        # Create a hash entry for Unicode::UCD to get the file that stores this
         # property's map table
         foreach my $alias ($table->aliases) {
             my $name = $alias->name;
@@ -16041,7 +16041,7 @@ sub register_file_for_name($$$) {
             }
         }
 
-        # And a way for utf8_heavy to find the proper key in the SwashInfo
+        # And a way for Unicode::UCD to find the proper key in the SwashInfo
         # hash for this property.
         $file_to_swash_name{$file} = "To" . $table->swash_name;
         return;
@@ -16124,7 +16124,7 @@ sub register_file_for_name($$$) {
         # goes through all aliases in the UCD that we generate regex match
         # files for
         foreach my $alias ($table->aliases) {
-            my $standard = utf8_heavy_name($table, $alias);
+            my $standard = UCD_name($table, $alias);
 
             # Generate an entry in either the loose or strict hashes, which
             # will translate the property and alias names combination into the
@@ -16144,9 +16144,9 @@ sub register_file_for_name($$$) {
                 else {
                     $stricter_to_file_of{$standard} = $sub_filename;
 
-                    # Tightly coupled with how utf8_heavy.pl works, for a
+                    # Tightly coupled with how Unicode::UCD works, for a
                     # floating point number that is a whole number, get rid of
-                    # the trailing decimal point and 0's, so that utf8_heavy
+                    # the trailing decimal point and 0's, so that Unicode::UCD
                     # will work.  Also note that this assumes that such a
                     # number is matched strictly; so if that were to change,
                     # this would be wrong.
@@ -16436,7 +16436,7 @@ sub make_re_pod_entries($) {
     # for each name each table goes by
     foreach my $table ($input_table, $input_table->children) {
 
-        # utf8_heavy.pl cannot deal with null string property values, so skip
+        # Unicode::UCD cannot deal with null string property values, so skip
         # any tables that have no non-null names.
         next if ! grep { $_->name ne "" } $table->aliases;
 
@@ -17668,7 +17668,7 @@ END
 
 sub make_Heavy () {
     # Create and write Heavy.pl, which passes info about the tables to
-    # utf8_heavy.pl
+    # Unicode::UCD
 
     # Stringify structures for output
     my $loose_property_name_of
@@ -17728,7 +17728,7 @@ sub make_Heavy () {
 $HEADER
 $INTERNAL_ONLY_HEADER
 
-# This file is for the use of utf8_heavy.pl and Unicode::UCD
+# This file is for the use of Unicode::UCD
 
 # Maps Unicode (not Perl single-form extensions) property names in loose
 # standard form to their corresponding standard names
@@ -18575,7 +18575,7 @@ sub write_all_tables() {
                 make_ucd_table_pod_entries($table);
 
                 # There is a mapping stored of the various synonyms to the
-                # standardized name of the property for utf8_heavy.pl.
+                # standardized name of the property for Unicode::UCD.
                 # Also, the pod file contains entries of the form:
                 # \p{alias: *}         \p{full: *}
                 # rather than show every possible combination of things.
@@ -18615,7 +18615,7 @@ sub write_all_tables() {
                         push @standard_list, $alias_standard;
                     }
 
-                    # For utf8_heavy, set the mapping of the alias to the
+                    # For Unicode::UCD, set the mapping of the alias to the
                     # property
                     if ($type == $STRING) {
                         if ($property->fate <= $MAP_PROXIED) {
index 9226393..62f7b8e 100644 (file)
 1;
 
 # Generated from:
-# 73902d92e2f05c2b707351006727708a3dc043d118f05aee169f70c117489d61 lib/Unicode/UCD.pm
+# 486ed9a6bcca738e67b88da8199ebc831063808044dc1d0ea98b494ab59ee34a lib/Unicode/UCD.pm
 # 5e91b649379ec79af7cfb6b09410a24557cba4c6d733cd0a2b8a78a1448736d2 lib/unicore/ArabicShaping.txt
 # f5feb19cd084b2b1568fbc0f94f4b4b54941406e7fb36c7570f8352fd5022dbe lib/unicore/BidiBrackets.txt
 # e6cbd8ffe94f2e0fbfa6695d6c06c1e72eef7d3aa93cb6329d111285198b5e62 lib/unicore/BidiMirroring.txt
 # 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
 # 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
 # 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
-# ad9f9ebb4ad5378ccb7437b0d15b213b3f9d1b7e5c095284a44bee5d84206be6 lib/unicore/mktables
+# 74dc5134f7e509239e1b3c8af319df951d1f41f917eceae9bd113c6740a613e6 lib/unicore/mktables
 # a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
 # 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
 # e9283c761c5a95e3379384ca47c13a284f08d743c2be6e5091f1152b1b6b7a37 regen/mk_PL_charclass.pl
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
deleted file mode 100644 (file)
index 1c54849..0000000
+++ /dev/null
@@ -1,622 +0,0 @@
-package utf8;
-use strict;
-use warnings;
-use re "/aa";  # So we won't even try to look at above Latin1, potentially
-               # resulting in a recursive call
-
-sub DEBUG () { 0 }
-$|=1 if DEBUG;
-
-sub DESTROY {}
-
-my %Cache;
-
-sub croak { require Carp; Carp::croak(@_) }
-
-# Digits may be separated by a single underscore
-my $digits = qr/ ( [0-9] _? )+ (?!:_) /x;
-
-# A sign can be surrounded by white space
-my $sign = qr/ \s* [+-]? \s* /x;
-
-my $f_float = qr/  $sign $digits+ \. $digits*    # e.g., 5.0, 5.
-                 | $sign $digits* \. $digits+/x; # 0.7, .7
-
-# A number may be an integer, a rational, or a float with an optional exponent
-# We (shudder) accept a signed denominator
-my $number = qr{  ^ $sign $digits+ $
-                | ^ $sign $digits+ \/ $sign $digits+ $
-                | ^ $f_float (?: [Ee] [+-]? $digits )? $}x;
-
-sub _loose_name ($) {
-    # Given a lowercase property or property-value name, return its
-    # standardized version that is expected for look-up in the 'loose' hashes
-    # in Heavy.pl (hence, this depends on what mktables does).  This squeezes
-    # out blanks, underscores and dashes.  The complication stems from the
-    # grandfathered-in 'L_', which retains a single trailing underscore.
-
-# integer or float (no exponent)
-my $integer_or_float_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;
-
-# Also includes rationals
-my $numeric_re = qr! $integer_or_float_re | ^ -? \d+ / \d+ $ !x;
-    return $_[0] if $_[0] =~ $numeric_re;
-
-    (my $loose = $_[0]) =~ s/[-_ \t]//g;
-
-    return $loose if $loose !~ / ^ (?: is | to )? l $/x;
-    return 'l_' if $_[0] =~ / l .* _ /x;    # If original had a trailing '_'
-    return $loose;
-}
-
-##
-## "SWASH" == "SWATCH HASH". A "swatch" is a swatch of the Unicode landscape.
-## It's a data structure that encodes a set of Unicode characters.
-##
-
-{
-    # If a floating point number is within this distance from the value of a
-    # fraction, it is considered to be that fraction, even if many more digits
-    # are specified that don't exactly match.
-    my $min_floating_slop;
-
-    # To guard against this program calling something that in turn ends up
-    # calling this program with the same inputs, and hence infinitely
-    # recursing, we keep a stack of the properties that are currently in
-    # progress, pushed upon entry, popped upon return.
-    my @recursed;
-
-    sub SWASHNEW {
-        my ($class, $type, $list, $minbits, $none) = @_;
-        my $user_defined = 0;
-        local $^D = 0 if $^D;
-
-        $class = "" unless defined $class;
-        print STDERR __LINE__, ": class=$class, type=$type, list=",
-                                (defined $list) ? $list : ':undef:',
-                                ", minbits=$minbits, none=$none\n" if DEBUG;
-
-        ##
-        ## Get the list of codepoints for the type.
-        ## Called from swash_init (see utf8.c) or SWASHNEW itself.
-        ##
-        ## Callers of swash_init:
-        ##     Unicode::UCD::prop_invlist
-        ##     Unicode::UCD::prop_invmap
-        ##
-        ## Given a $type, our goal is to fill $list with the set of codepoint
-        ## ranges. If $type is false, $list passed is used.
-        ##
-        ## $minbits:
-        ##     For binary properties, $minbits must be 1.
-        ##     For character mappings (case and transliteration), $minbits must
-        ##     be a number except 1.
-        ##
-        ## $list (or that filled according to $type):
-        ##     Refer to perlunicode.pod, "User-Defined Character Properties."
-        ##     
-        ##     For binary properties, only characters with the property value
-        ##     of True should be listed. The 3rd column, if any, will be ignored
-        ##
-        ## $none is undocumented, so I'm (khw) trying to do some documentation
-        ## of it now.  It appears to be if there is a mapping in an input file
-        ## that maps to 'XXXX', then that is replaced by $none+1, expressed in
-        ## hexadecimal.  It is no longer used.
-        ##
-        ## To make the parsing of $type clear, this code takes the a rather
-        ## unorthodox approach of last'ing out of the block once we have the
-        ## info we need. Were this to be a subroutine, the 'last' would just
-        ## be a 'return'.
-        ##
-        #   If a problem is found $type is returned;
-        #   Upon success, a new (or cached) blessed object is returned with
-        #   keys TYPE, BITS, EXTRAS, LIST, and NONE with values having the
-        #   same meanings as the input parameters.
-        #   SPECIALS contains a reference to any special-treatment hash in the
-        #       property.
-        #   INVERT_IT is non-zero if the result should be inverted before use
-        #   USER_DEFINED is non-zero if the result came from a user-defined
-        my $file; ## file to load data from, and also part of the %Cache key.
-
-        # Change this to get a different set of Unicode tables
-        my $unicore_dir = 'unicore';
-        my $invert_it = 0;
-        my $list_is_from_mktables = 0;  # Is $list returned from a mktables
-                                        # generated file?  If so, we know it's
-                                        # well behaved.
-
-        if ($type)
-        {
-            # Verify that this isn't a recursive call for this property.
-            # Can't use croak, as it may try to recurse to here itself.
-            my $class_type = $class . "::$type";
-            if (grep { $_ eq $class_type } @recursed) {
-                CORE::die "panic: Infinite recursion in SWASHNEW for '$type'\n";
-            }
-            push @recursed, $class_type;
-
-            $type =~ s/^\s+//;
-            $type =~ s/\s+$//;
-
-            # regcomp.c surrounds the property name with '__" and '_i' if this
-            # is to be caseless matching.
-            my $caseless = $type =~ s/^(.*)__(.*)_i$/$1$2/;
-
-            print STDERR __LINE__, ": type=$type, caseless=$caseless\n" if DEBUG;
-
-        GETFILE:
-            {
-                ##
-                ## It could be a user-defined property.  Look in current
-                ## package if no package given
-                ##
-
-
-                my $caller0 = caller(0);
-                my $caller1 = $type =~ s/(.+):://
-                              ? $1
-                              : $caller0 eq 'main'
-                                ? 'main'
-                                : caller(1);
-
-                if (defined $caller1 && $type =~ /^I[ns]\w+$/) {
-                    my $prop = "${caller1}::$type";
-                    if (exists &{$prop}) {
-                        # stolen from Scalar::Util::PP::tainted()
-                        my $tainted;
-                        {
-                            local($@, $SIG{__DIE__}, $SIG{__WARN__});
-                            local $^W = 0;
-                            no warnings;
-                            eval { kill 0 * $prop };
-                            $tainted = 1 if $@ =~ /^Insecure/;
-                        }
-                        die "Insecure user-defined property \\p{$prop}\n"
-                            if $tainted;
-                        no strict 'refs';
-                        $list = &{$prop}($caseless);
-                        $user_defined = 1;
-                        last GETFILE;
-                    }
-                }
-
-                # During Perl's compilation, this routine may be called before
-                # the tables are constructed.  If so, we have a chicken/egg
-                # problem.  If we die, the tables never get constructed, so
-                # keep going, but return an empty table so only what the code
-                # has compiled in internally (currently ASCII/Latin1 range
-                # matching) will work.
-                BEGIN {
-                    # Poor man's constant, to avoid a run-time check.
-                    $utf8::{miniperl}
-                        = \! defined &DynaLoader::boot_DynaLoader;
-                }
-                if (miniperl) {
-                    eval "require '$unicore_dir/Heavy.pl'";
-                    if ($@) {
-                        print STDERR __LINE__, ": '$@'\n" if DEBUG;
-                        pop @recursed if @recursed;
-                        return $type;
-                    }
-                }
-                else {
-                    require "$unicore_dir/Heavy.pl";
-                }
-                BEGIN { delete $utf8::{miniperl} }
-
-                # All property names are matched caselessly
-                my $property_and_table = CORE::lc $type;
-                print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
-
-                # See if is of the compound form 'property=value', where the
-                # value indicates the table we should use.
-                my ($property, $table, @remainder) =
-                                    split /\s*[:=]\s*/, $property_and_table, -1;
-                if (@remainder) {
-                    pop @recursed if @recursed;
-                    return $type;
-                }
-
-                my $prefix;
-                if (! defined $table) {
-                        
-                    # Here, is the single form.  The property becomes empty, and
-                    # the whole value is the table.
-                    $table = $property;
-                    $prefix = $property = "";
-                } else {
-                    print STDERR __LINE__, ": $property\n" if DEBUG;
-
-                    # Here it is the compound property=table form.  The property
-                    # name is always loosely matched, and always can have an
-                    # optional 'is' prefix (which isn't true in the single
-                    # form).
-                    $property = _loose_name($property) =~ s/^is//r;
-
-                    # And convert to canonical form.  Quit if not valid.
-                    $property = $utf8::loose_property_name_of{$property};
-                    if (! defined $property) {
-                        pop @recursed if @recursed;
-                        return $type;
-                    }
-
-                    $prefix = "$property=";
-
-                    # If the rhs looks like it is a number...
-                    print STDERR __LINE__, ": table=$table\n" if DEBUG;
-
-                    if ($table =~ $number) {
-                        print STDERR __LINE__, ": table=$table\n" if DEBUG;
-
-                        # Split on slash, in case it is a rational, like \p{1/5}
-                        my @parts = split m{ \s* / \s* }x, $table, -1;
-                        print __LINE__, ": $type\n" if @parts > 2 && DEBUG;
-
-                        foreach my $part (@parts) {
-                            print __LINE__, ": part=$part\n" if DEBUG;
-
-                            $part =~ s/^\+\s*//;    # Remove leading plus
-                            $part =~ s/^-\s*/-/;    # Remove blanks after unary
-                                                    # minus
-
-                            # Remove underscores between digits.
-                            $part =~ s/(?<= [0-9] ) _ (?= [0-9] ) //xg;
-
-                            # No leading zeros (but don't make a single '0'
-                            # into a null string)
-                            $part =~ s/ ^ ( -? ) 0+ /$1/x;
-                            $part .= '0' if $part eq '-' || $part eq "";
-
-                            # No trailing zeros after a decimal point
-                            $part =~ s/ ( \. [0-9]*? ) 0+ $ /$1/x;
-
-                            # Begin with a 0 if a leading decimal point
-                            $part =~ s/ ^ ( -? ) \. /${1}0./x;
-
-                            # Ensure not a trailing decimal point: turn into an
-                            # integer
-                            $part =~ s/ \. $ //x;
-
-                            print STDERR __LINE__, ": part=$part\n" if DEBUG;
-                            #return $type if $part eq "";
-                        }
-
-                        #  If a rational...
-                        if (@parts == 2) {
-
-                            # If denominator is negative, get rid of it, and ...
-                            if ($parts[1] =~ s/^-//) {
-
-                                # If numerator is also negative, convert the
-                                # whole thing to positive, else move the minus
-                                # to the numerator
-                                if ($parts[0] !~ s/^-//) {
-                                    $parts[0] = '-' . $parts[0];
-                                }
-                            }
-                            $table = join '/', @parts;
-                        }
-                        elsif ($property ne 'nv' || $parts[0] !~ /\./) {
-
-                            # Here is not numeric value, or doesn't have a
-                            # decimal point.  No further manipulation is
-                            # necessary.  (Note the hard-coded property name.
-                            # This could fail if other properties eventually
-                            # had fractions as well; perhaps the cjk ones
-                            # could evolve to do that.  This hard-coding could
-                            # be fixed by mktables generating a list of
-                            # properties that could have fractions.)
-                            $table = $parts[0];
-                        } else {
-
-                            # Here is a floating point numeric_value.  Convert
-                            # to rational.  Get a normalized form, like
-                            # 5.00E-01, and look that up in the hash
-
-                            my $float = sprintf "%.*e",
-                                                $utf8::e_precision,
-                                                0 + $parts[0];
-
-                            if (exists $utf8::nv_floating_to_rational{$float}) {
-                                $table = $utf8::nv_floating_to_rational{$float};
-                            } else {
-                                pop @recursed if @recursed;
-                                return $type;
-                            }
-                        }
-                        print STDERR __LINE__, ": $property=$table\n" if DEBUG;
-                    }
-                }
-
-                # Combine lhs (if any) and rhs to get something that matches
-                # the syntax of the lookups.
-                $property_and_table = "$prefix$table";
-                print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
-
-                # First try stricter matching.
-                $file = $utf8::stricter_to_file_of{$property_and_table};
-
-                # If didn't find it, try again with looser matching by editing
-                # out the applicable characters on the rhs and looking up
-                # again.
-                my $strict_property_and_table;
-                if (! defined $file) {
-
-                    # This isn't used unless the name begins with 'to'
-                    $strict_property_and_table = $property_and_table =~  s/^to//r;
-                    $table = _loose_name($table);
-                    $property_and_table = "$prefix$table";
-                    print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
-                    $file = $utf8::loose_to_file_of{$property_and_table};
-                }
-
-                # Add the constant and go fetch it in.
-                if (defined $file) {
-
-                    # If the file name contains a !, it means to invert.  The
-                    # 0+ makes sure result is numeric
-                    $invert_it = 0 + $file =~ s/!//;
-
-                    if ($utf8::why_deprecated{$file}) {
-                        warnings::warnif('deprecated', "Use of '$type' in \\p{} or \\P{} is deprecated because: $utf8::why_deprecated{$file};");
-                    }
-
-                    if ($caseless
-                        && exists $utf8::caseless_equivalent{$property_and_table})
-                    {
-                        $file = $utf8::caseless_equivalent{$property_and_table};
-                    }
-
-                    # The pseudo-directory '#' means that there really isn't a
-                    # file to read, the data is in-line as part of the string;
-                    # we extract it below.
-                    $file = "$unicore_dir/lib/$file.pl" unless $file =~ m!^#/!;
-                    last GETFILE;
-                }
-                print STDERR __LINE__, ": didn't find $property_and_table\n" if DEBUG;
-
-                ##
-                ## Last attempt -- see if it's a standard "To" name
-                ## (e.g. "ToLower")  ToTitle is used by ucfirst().
-                ## The user-level way to access ToDigit() and ToFold()
-                ## is to use Unicode::UCD.
-                ##
-                # Only check if caller wants non-binary
-                if ($minbits != 1) {
-                    if ($property_and_table =~ s/^to//) {
-                    # Look input up in list of properties for which we have
-                    # mapping files.  First do it with the strict approach
-                        if (defined ($file = $utf8::strict_property_to_file_of{
-                                                    $strict_property_and_table}))
-                        {
-                            $type = $utf8::file_to_swash_name{$file};
-                            print STDERR __LINE__, ": type set to $type\n"
-                                                                        if DEBUG;
-                            $file = "$unicore_dir/$file.pl";
-                            last GETFILE;
-                        }
-                        elsif (defined ($file =
-                          $utf8::loose_property_to_file_of{$property_and_table}))
-                        {
-                            $type = $utf8::file_to_swash_name{$file};
-                            print STDERR __LINE__, ": type set to $type\n"
-                                                                        if DEBUG;
-                            $file = "$unicore_dir/$file.pl";
-                            last GETFILE;
-                        }   # If that fails see if there is a corresponding binary
-                            # property file
-                        elsif (defined ($file =
-                                    $utf8::loose_to_file_of{$property_and_table}))
-                        {
-
-                            # Here, there is no map file for the property we
-                            # are trying to get the map of, but this is a
-                            # binary property, and there is a file for it that
-                            # can easily be translated to a mapping, so use
-                            # that, treating this as a binary property.
-                            # Setting 'minbits' here causes it to be stored as
-                            # such in the cache, so if someone comes along
-                            # later looking for just a binary, they get it.
-                            $minbits = 1;
-
-                            # The 0+ makes sure is numeric
-                            $invert_it = 0 + $file =~ s/!//;
-                            $file = "$unicore_dir/lib/$file.pl"
-                                                         unless $file =~ m!^#/!;
-                            last GETFILE;
-                        }
-                    }
-                }
-
-                ##
-                ## If we reach this line, it's because we couldn't figure
-                ## out what to do with $type. Ouch.
-                ##
-
-                pop @recursed if @recursed;
-                return $type;
-            } # end of GETFILE block
-
-            if (defined $file) {
-                print STDERR __LINE__, ": found it (file='$file')\n" if DEBUG;
-
-                ##
-                ## If we reach here, it was due to a 'last GETFILE' above
-                ## (exception: user-defined properties and mappings), so we
-                ## have a filename, so now we load it if we haven't already.
-
-                # The pseudo-directory '#' means the result isn't really a
-                # file, but is in-line, with semi-colons to be turned into
-                # new-lines.  Since it is in-line there is no advantage to
-                # caching the result
-                if ($file =~ s!^#/!!) {
-                    $list = $utf8::inline_definitions[$file];
-                }
-                else {
-                    # Here, we have an actual file to read in and load, but it
-                    # may already have been read-in and cached.  The cache key
-                    # is the class and file to load, and whether the results
-                    # need to be inverted.
-                    my $found = $Cache{$class, $file, $invert_it};
-                    if ($found and ref($found) eq $class) {
-                        print STDERR __LINE__, ": Returning cached swash for '$class,$file,$invert_it' for \\p{$type}\n" if DEBUG;
-                        pop @recursed if @recursed;
-                        return $found;
-                    }
-
-                    local $@;
-                    local $!;
-                    $list = do $file; die $@ if $@;
-                }
-
-                $list_is_from_mktables = 1;
-            }
-        } # End of $type is non-null
-
-        # Here, either $type was null, or we found the requested property and
-        # read it into $list
-
-        my $extras = "";
-
-        my $bits = $minbits;
-
-        # mktables lists don't have extras, like '&utf8::prop', so don't need
-        # to separate them; also lists are already sorted, so don't need to do
-        # that.
-        if ($list && ! $list_is_from_mktables) {
-            my $taint = substr($list,0,0); # maintain taint
-
-            # Separate the extras from the code point list, and make sure
-            # user-defined properties are well-behaved for
-            # downstream code.
-            if ($user_defined || $none) {
-                my @tmp = split(/^/m, $list);
-                my %seen;
-                no warnings;
-
-                # The extras are anything that doesn't begin with a hex digit.
-                $extras = join '', $taint, grep /^[^0-9a-fA-F]/, @tmp;
-
-                # Remove the extras, and sort the remaining entries by the
-                # numeric value of their beginning hex digits, removing any
-                # duplicates.
-                $list = join '', $taint,
-                        map  { $_->[1] }
-                        sort { $a->[0] <=> $b->[0] }
-                        map  { /^([0-9a-fA-F]+)/ && !$seen{$1}++ ? [ CORE::hex($1), $_ ] : () }
-                        @tmp; # XXX doesn't do ranges right
-            }
-            else {
-                # mktables has gone to some trouble to make non-user defined
-                # properties well-behaved, so we can skip the effort we do for
-                # user-defined ones.  Any extras are at the very beginning of
-                # the string.
-
-                # This regex splits out the first lines of $list into $1 and
-                # strips them off from $list, until we get one that begins
-                # with a hex number, alone on the line, or followed by a tab.
-                # Either portion may be empty.
-                $list =~ s/ \A ( .*? )
-                            (?: \z | (?= ^ [0-9a-fA-F]+ (?: \t | $) ) )
-                          //msx;
-
-                $extras = "$taint$1";
-            }
-        }
-
-        if ($none) {
-            my $hextra = sprintf "%04x", $none + 1;
-            $list =~ s/\tXXXX$/\t$hextra/mg;
-        }
-
-        if ($minbits != 1 && $minbits < 32) { # not binary property
-            my $top = 0;
-            while ($list =~ /^([0-9a-fA-F]+)(?:[\t]([0-9a-fA-F]+)?)(?:[ \t]([0-9a-fA-F]+))?/mg) {
-                my $min = CORE::hex $1;
-                my $max = defined $2 ? CORE::hex $2 : $min;
-                my $val = defined $3 ? CORE::hex $3 : 0;
-                $val += $max - $min if defined $3;
-                $top = $val if $val > $top;
-            }
-            my $topbits =
-                $top > 0xffff ? 32 :
-                $top > 0xff ? 16 : 8;
-            $bits = $topbits if $bits < $topbits;
-        }
-
-        my @extras;
-        if ($extras) {
-            for my $x ($extras) {
-                my $taint = substr($x,0,0); # maintain taint
-                pos $x = 0;
-                while ($x =~ /^([^0-9a-fA-F\n])(.*)/mg) {
-                    my $char = "$1$taint";
-                    my $name = "$2$taint";
-                    print STDERR __LINE__, ": char [$char] => name [$name]\n"
-                        if DEBUG;
-                    if ($char =~ /[-+!&]/) {
-                        my ($c,$t) = split(/::/, $name, 2);    # bogus use of ::, really
-                        my $subobj;
-                        if ($c eq 'utf8') {
-                            $subobj = utf8->SWASHNEW($t, "", $minbits, 0);
-                        }
-                        elsif (exists &$name) {
-                            $subobj = utf8->SWASHNEW($name, "", $minbits, 0);
-                        }
-                        elsif ($c =~ /^([0-9a-fA-F]+)/) {
-                            $subobj = utf8->SWASHNEW("", $c, $minbits, 0);
-                        }
-                        print STDERR __LINE__, ": returned from getting sub object for $name\n" if DEBUG;
-                        if (! ref $subobj) {
-                            pop @recursed if @recursed && $type;
-                            return $subobj;
-                        }
-                        push @extras, $name => $subobj;
-                        $bits = $subobj->{BITS} if $bits < $subobj->{BITS};
-                        $user_defined = $subobj->{USER_DEFINED}
-                                              if $subobj->{USER_DEFINED};
-                    }
-                }
-            }
-        }
-
-        if (DEBUG) {
-            print STDERR __LINE__, ": CLASS = $class, TYPE => $type, BITS => $bits, NONE => $none, INVERT_IT => $invert_it, USER_DEFINED => $user_defined";
-            print STDERR "\nLIST =>\n$list" if defined $list;
-            print STDERR "\nEXTRAS =>\n$extras" if defined $extras;
-            print STDERR "\n";
-        }
-
-        my $SWASH = bless {
-            TYPE => $type,
-            BITS => $bits,
-            EXTRAS => $extras,
-            LIST => $list,
-            NONE => $none,
-            USER_DEFINED => $user_defined,
-            @extras,
-        } => $class;
-
-        if ($file) {
-            $Cache{$class, $file, $invert_it} = $SWASH;
-            if ($type
-                && exists $utf8::SwashInfo{$type}
-                && exists $utf8::SwashInfo{$type}{'specials_name'})
-            {
-                my $specials_name = $utf8::SwashInfo{$type}{'specials_name'};
-                no strict "refs";
-                print STDERR "\nspecials_name => $specials_name\n" if DEBUG;
-                $SWASH->{'SPECIALS'} = \%$specials_name;
-            }
-            $SWASH->{'INVERT_IT'} = $invert_it;
-        }
-
-        pop @recursed if @recursed && $type;
-
-        return $SWASH;
-    }
-}
-
-# Now SWASHGET is recasted into a C function S_swatch_get (see utf8.c).
-
-1;
index cf2a344..4d3c51d 100644 (file)
 #endif /* PERL_REGCHARCLASS_H_ */
 
 /* Generated from:
- * 73902d92e2f05c2b707351006727708a3dc043d118f05aee169f70c117489d61 lib/Unicode/UCD.pm
+ * 486ed9a6bcca738e67b88da8199ebc831063808044dc1d0ea98b494ab59ee34a lib/Unicode/UCD.pm
  * 5e91b649379ec79af7cfb6b09410a24557cba4c6d733cd0a2b8a78a1448736d2 lib/unicore/ArabicShaping.txt
  * f5feb19cd084b2b1568fbc0f94f4b4b54941406e7fb36c7570f8352fd5022dbe lib/unicore/BidiBrackets.txt
  * e6cbd8ffe94f2e0fbfa6695d6c06c1e72eef7d3aa93cb6329d111285198b5e62 lib/unicore/BidiMirroring.txt
  * 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
  * 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
  * 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
- * ad9f9ebb4ad5378ccb7437b0d15b213b3f9d1b7e5c095284a44bee5d84206be6 lib/unicore/mktables
+ * 74dc5134f7e509239e1b3c8af319df951d1f41f917eceae9bd113c6740a613e6 lib/unicore/mktables
  * a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
  * 8cffbf838b6e8ea5310e4ad2e0498ad9c1d87d4babead678081859473591317c regen/regcharclass.pl
index a86a3b3..06d0c17 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -23000,7 +23000,7 @@ Perl_parse_uniprop_string(pTHX_
                                 Titlecase Mapping  (both full and simple)
                                 Uppercase Mapping  (both full and simple)
              * Move the part that looks at the property values into a perl
-             * script, like utf8_heavy.pl is done.  This makes things somewhat
+             * script, like utf8_heavy.pl was done.  This makes things somewhat
              * easier, but most importantly, it avoids always adding all these
              * strings to the memory usage when the feature is little-used.
              *
index d31e5c0..688d851 100644 (file)
@@ -25,7 +25,7 @@ BEGIN {
 skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
 skip_all_without_unicode_tables();
 
-plan tests => 967;  # Update this when adding/deleting tests.
+plan tests => 966;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1745,27 +1745,6 @@ EOP
         like("X", qr/$x/, "UTF-8 of /[x]/i matches upper case");
     }
 
-SKIP: {   # make sure we get an error when \p{} cannot load Unicode tables
-        skip("Unicode tables always now loaded", 1);
-        fresh_perl_like(<<'        prog that cannot load uni tables',
-            BEGIN {
-                @INC = '../lib';
-                require utf8; require 'utf8_heavy.pl';
-                @INC = ();
-            }
-            $name = 'A B';
-            if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){
-                print "It's good! >$1< >$2<\n";
-            } else {
-                print "It's not good...\n";
-            }
-        prog that cannot load uni tables
-                  qr/^Can't locate unicore\/Heavy\.pl(?x:
-                   )|^Can't find Unicode property definition/,
-                  undef,
-                 '\p{} should not fail silently when uni tables evanesce');
-    }
-
     {   # Special handling of literal-ended ranges in [...] was breaking this
         use utf8;
         like("ÿ", qr/[ÿ-ÿ]/, "\"ÿ\" should match [ÿ-ÿ]");
index 392e016..7983d43 100644 (file)
@@ -7238,7 +7238,7 @@ MPH_VALt match_uniprop( const unsigned char * const key, const U16 key_len ) {
 }
 
 /* Generated from:
- * 73902d92e2f05c2b707351006727708a3dc043d118f05aee169f70c117489d61 lib/Unicode/UCD.pm
+ * 486ed9a6bcca738e67b88da8199ebc831063808044dc1d0ea98b494ab59ee34a lib/Unicode/UCD.pm
  * 5e91b649379ec79af7cfb6b09410a24557cba4c6d733cd0a2b8a78a1448736d2 lib/unicore/ArabicShaping.txt
  * f5feb19cd084b2b1568fbc0f94f4b4b54941406e7fb36c7570f8352fd5022dbe lib/unicore/BidiBrackets.txt
  * e6cbd8ffe94f2e0fbfa6695d6c06c1e72eef7d3aa93cb6329d111285198b5e62 lib/unicore/BidiMirroring.txt
@@ -7284,7 +7284,7 @@ MPH_VALt match_uniprop( const unsigned char * const key, const U16 key_len ) {
  * 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
  * 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
  * 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
- * ad9f9ebb4ad5378ccb7437b0d15b213b3f9d1b7e5c095284a44bee5d84206be6 lib/unicore/mktables
+ * 74dc5134f7e509239e1b3c8af319df951d1f41f917eceae9bd113c6740a613e6 lib/unicore/mktables
  * a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
  * e9283c761c5a95e3379384ca47c13a284f08d743c2be6e5091f1152b1b6b7a37 regen/mk_PL_charclass.pl