This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/re/regexp_unicode_prop.t: Add tests for run-time
authorKarl Williamson <khw@cpan.org>
Mon, 6 Aug 2018 23:12:08 +0000 (17:12 -0600)
committerKarl Williamson <khw@cpan.org>
Mon, 20 Aug 2018 16:51:56 +0000 (10:51 -0600)
User-defined \p{} properties can be referred to in a regex pattern
compilation before their definition is encountered.  This is supposed to
work, and their definitions get compiled when needed at run-time.  But
there was only one test that this worked.  This commit restructures
things so that every user-defined property is compiled into a pattern
before its definition is known, and also into another pattern after its
definition is known.

This removes the need to special case the earlier single one that did
this test.

t/re/regexp_unicode_prop.t

index 3193e10..e720339 100644 (file)
@@ -105,7 +105,16 @@ my @CLASSES = (
 
 );
 
-    my @USER_DEFINED_PROPERTIES = (
+my @USER_DEFINED_PROPERTIES;
+my @USER_CASELESS_PROPERTIES;
+my @DEFERRED;
+BEGIN {
+
+    # We defined these at compile time, so that the subroutines that they
+    # refer to aren't known, so that we can test properties not known until
+    # runtime
+
+    @USER_DEFINED_PROPERTIES = (
         #
         # User defined properties
         #
@@ -124,20 +133,45 @@ my @CLASSES = (
         Dash                      => ['-'],
         ASCII_Hex_Digit           => ['!-', 'A'],
         IsAsciiHexAndDash         => ['-', 'A'],
-
-        # This overrides the official one
-        InLatin1                  => ['\x{0100}', '!\x{00FF}'],
     );
 
-    my @USER_CASELESS_PROPERTIES = (
+    @USER_CASELESS_PROPERTIES = (
         #
         # User defined properties which differ depending on /i.  Second entry
         # is false normally, true under /i
         #
         'IsMyUpper'                => ["M", "!m" ],
+        'pkg::IsMyLower'           => ["a", "!A" ],
     );
 
 
+    # Now create a list of properties whose definitions won't be known at
+    # runtime.  The qr// below thus will have forward references to them, and
+    # when matched at runtime will not know what's in the property definition
+    my @DEFERRABLE_USER_DEFINED_PROPERTIES;
+    push @DEFERRABLE_USER_DEFINED_PROPERTIES, @USER_DEFINED_PROPERTIES;
+    push @DEFERRABLE_USER_DEFINED_PROPERTIES, @USER_CASELESS_PROPERTIES;
+    for (my $i = 0; $i < @DEFERRABLE_USER_DEFINED_PROPERTIES; $i+=2) {
+        my $property = $DEFERRABLE_USER_DEFINED_PROPERTIES[$i];
+        if ($property =~ / ^ \# /x) {
+            $i++;
+            redo;
+        }
+
+        # Only do this for the properties in the list that are user-defined
+        next if ($property !~ / ( ^ | :: ) I[ns] /x);
+
+        push @DEFERRED, qr/\p{$property}/,
+                        $DEFERRABLE_USER_DEFINED_PROPERTIES[$i+1];
+    }
+}
+
+# These override the official ones, so if found before defined, the official
+# ones prevail, so can't test deferred definition
+my @OVERRIDING_USER_DEFINED_PROPERTIES = (
+   InLatin1                  => ['\x{0100}', '!\x{00FF}'],
+);
+
 #
 # From the short properties we populate POSIX-like classes.
 #
@@ -187,7 +221,8 @@ while (my ($class, $chars) = each %SHORT_PROPERTIES) {
 
 push @CLASSES => "# Short properties"        => %SHORT_PROPERTIES,
                  "# POSIX like properties"   => %d,
-                 "# User defined properties" => @USER_DEFINED_PROPERTIES;
+                 "# User defined properties" => @USER_DEFINED_PROPERTIES,
+                 "# Overriding user defined properties" => @OVERRIDING_USER_DEFINED_PROPERTIES;
 
 
 #
@@ -201,7 +236,7 @@ for (my $i = 0; $i < @CLASSES; $i += 2) {
 $count += 4 * @ILLEGAL_PROPERTIES;
 $count += 4 * grep {length $_ == 1} @ILLEGAL_PROPERTIES;
 $count += 8 * @USER_CASELESS_PROPERTIES;
-$count += 1;    # Test for pkg:IsMyLower
+$count += 1 * @DEFERRED / 2;
 $count += 1;    # No warnings generated
 
 plan(tests => $count);
@@ -232,6 +267,12 @@ sub match {
 
 sub run_tests {
 
+    for (my $i = 0; $i < @DEFERRED; $i+=2) {
+            my ($str, $name) = get_str_name($DEFERRED[$i+1][0]);
+            like($str, $DEFERRED[$i],
+                "$name correctly matched $DEFERRED[$i] (defn. not known until runtime)");
+    }
+
     while (@CLASSES) {
         my $class = shift @CLASSES;
         if ($class =~ /^\h*#\h*(.*)/) {
@@ -374,13 +415,6 @@ sub IsMyUpper {
            . "\n&utf8::ASCII";
 }
 
-{   # This has to be done here and not like the others, because we have to
-    # make sure that the property is not known until after the regex is
-    # compiled.  It was previously getting confused about the pkg and /i
-    # combination
-
-    my $mylower = qr/\p{pkg::IsMyLower}/i;
-
 sub pkg::IsMyLower {
     my $caseless = shift;
     return "+utf8::"
@@ -390,10 +424,6 @@ sub pkg::IsMyLower {
         . "\n&utf8::ASCII";
 }
 
-    like("A", $mylower, "Not available until runtime user-defined property with pkg:: and /i works");
-
-}
-
 # Verify that can use user-defined properties inside another one
 sub IsSyriac1KanaMark {<<'--'}
 +main::IsSyriac1