This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/mk_PL_charclass.pl: Move code to subroutine
authorKarl Williamson <public@khwilliamson.com>
Sat, 20 Oct 2012 22:15:48 +0000 (16:15 -0600)
committerKarl Williamson <public@khwilliamson.com>
Sat, 20 Oct 2012 23:31:49 +0000 (17:31 -0600)
This code is for just this property and was kludged in to be executed in
the general loop.  It makes more sense to it to be in the subroutine
that handles the property that was just added in a prior commit.

It also changes the output slightly.  The Latin1 sharp S isn't a
non-final fold, unlike what was said previously

l1_char_class_tab.h
regen/mk_PL_charclass.pl

index 7db7d34..286b666 100644 (file)
 /* U+DC U WITH DIAERESIS */ (1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
 /* U+DD Y WITH ACUTE */ (1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
 /* U+DE THORN */ (1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
-/* U+DF sharp s */ (1U<<_CC_NONLATIN1_FOLD)|(1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_NON_FINAL_FOLD)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
+/* U+DF sharp s */ (1U<<_CC_NONLATIN1_FOLD)|(1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
 /* U+E0 a with grave */ (1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
 /* U+E1 a with acute */ (1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
 /* U+E2 a with circumflex */ (1U<<_CC_ALNUMC)|(1U<<_CC_ALPHA)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD),
index 18ab4ad..18d535f 100644 (file)
@@ -116,7 +116,16 @@ BEGIN { # Have to do this at compile time because using user-defined \p{property
             push @{$folded_closure{$fold}}, $from if $fold < 256;
             push @{$folded_closure{$from}}, $fold if $from < 256;
 
-            push @hex_non_final_folds, $hex_fold if $i < @folded-1 && $fold < 256;
+            if ($i < @folded-1
+                && $fold < 256
+                && ! grep { $_ eq $hex_fold } @hex_non_final_folds)
+            {
+                push @hex_non_final_folds, $hex_fold;
+
+                # Also add the upper case, which in the latin1 range folds to
+                # $fold
+                push @hex_non_final_folds, sprintf "%04X", ord uc chr $fold;
+            }
         }
     }
 
@@ -199,11 +208,7 @@ for my $ord (0..255) {
             carp $@ if ! defined $re;
         }
         #print "$ord, $name $property, $re\n";
-        if ($char =~ $re  # Add this property if matches
-            || ($name eq 'NON_FINAL_FOLD'
-                # Also include chars that fold to the non-final
-                && CORE::fc($char) =~ $re))
-        {
+        if ($char =~ $re) {  # Add this property if matches
             $bits[$ord] .= '|' if $bits[$ord];
             $bits[$ord] .= "(1U<<_CC_$property)";
         }