This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix finite/finitel/isfinite in configure.com.
[perl5.git] / lib / utf8_heavy.pl
index 23e06f9..3cd8e83 100644 (file)
@@ -1,6 +1,8 @@
 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;
@@ -93,9 +95,9 @@ sub _loose_name ($) {
         #   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
-        #       property.
         my $file; ## file to load data from, and also part of the %Cache key.
 
         # Change this to get a different set of Unicode tables
@@ -133,8 +135,11 @@ sub _loose_name ($) {
 
 
                 my $caller0 = caller(0);
-                my $caller1 = $type =~ s/(.+)::// ? $1 : $caller0 eq 'main' ?
-                'main' : caller(1);
+                my $caller1 = $type =~ s/(.+):://
+                              ? $1
+                              : $caller0 eq 'main'
+                                ? 'main'
+                                : caller(1);
 
                 if (defined $caller1 && $type =~ /^I[ns]\w+$/) {
                     my $prop = "${caller1}::$type";
@@ -244,7 +249,7 @@ sub _loose_name ($) {
                                                     # minus
 
                             # Remove underscores between digits.
-                            $part =~ s/( ?<= [0-9] ) _ (?= [0-9] ) //xg;
+                            $part =~ s/(?<= [0-9] ) _ (?= [0-9] ) //xg;
 
                             # No leading zeros (but don't make a single '0'
                             # into a null string)
@@ -405,9 +410,9 @@ sub _loose_name ($) {
                 # Add the constant and go fetch it in.
                 if (defined $file) {
 
-                    # A beginning ! means to invert.  The 0+ makes sure is
-                    # numeric
-                    $invert_it = 0 + $file =~ s/^!//;
+                    # 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};");
@@ -418,7 +423,11 @@ sub _loose_name ($) {
                     {
                         $file = $utf8::caseless_equivalent{$property_and_table};
                     }
-                    $file= "$unicore_dir/lib/$file.pl";
+
+                    # 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;
@@ -480,8 +489,8 @@ sub _loose_name ($) {
                         $minbits = 1;
 
                         # The 0+ makes sure is numeric
-                        $invert_it = 0 + $file =~ s/^!//;
-                        $file = "$unicore_dir/lib/$file.pl";
+                        $invert_it = 0 + $file =~ s/!//;
+                        $file = "$unicore_dir/lib/$file.pl" unless $file =~ m!^#/!;
                         last GETFILE;
                     }
                 } }
@@ -502,20 +511,31 @@ sub _loose_name ($) {
                 ## 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.
-                ## If we have, return the cached results. 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;
+
+                # 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 $@;
                 }
 
-                local $@;
-                local $!;
-                $list = do $file; die $@ if $@;
                 $list_is_from_mktables = 1;
             }
         } # End of $type is non-null