Fix merge issues, remove excess files - match perl-5.28.1 dist

looking good sthen@, Great! bluhm@

1 files changed, 84 insertions, 22 deletions

diff --git a/gnu/usr.bin/perl/t/re/regexp.t b/gnu/usr.bin/perl/t/re/regexp.t
index 8e98e55d8d9..037d7b7a488 100755
--- a/gnu/usr.bin/perl/t/re/regexp.t
+++ b/gnu/usr.bin/perl/t/re/regexp.t
@@ -5,8 +5,9 @@
 # There are five columns, separated by tabs.
 # An optional sixth column is used to give a reason, only when skipping tests
 #
-# Column 1 contains the pattern, optionally enclosed in C<''>.
-# Modifiers can be put after the closing C<'>.
+# Column 1 contains the pattern, optionally enclosed in C<''> C<::> or
+# C<//>.  Modifiers can be put after the closing delimiter.  C<''> will
+# automatically be added to any other patterns.
 #
 # Column 2 contains the string to be matched.
 #
@@ -70,6 +71,13 @@ BEGIN {
 	print("1..0 # Skip Unicode tables not built yet\n"), exit
 	    unless eval 'require "unicore/Heavy.pl"';
     }
+
+    # Some of the tests need a locale; which one doesn't much matter, except
+    # that it be valid.  Make sure of that
+    eval { require POSIX;
+            POSIX->import(qw(LC_ALL setlocale));
+            POSIX::setlocale(&LC_ALL, "C");
+    };
 }
 
 sub _comment {
@@ -97,10 +105,11 @@ sub convert_from_ascii {
 
 use strict;
 use warnings FATAL=>"all";
-use vars qw($bang $ffff $nulnul); # used by the tests
-use vars qw($qr $skip_amp $qr_embed $qr_embed_thr $regex_sets); # set by our callers
-
+our ($bang, $ffff, $nulnul); # used by the tests
+our ($qr, $skip_amp, $qr_embed, $qr_embed_thr, $regex_sets, $alpha_assertions, $no_null); # set by our callers
 
+my $expanded_text = "expanded name from original test number";
+my $expanded_text_re = qr/$expanded_text/;
 
 if (!defined $file) {
     open TESTS, 're/re_tests' or die "Can't open re/re_tests: $!";
@@ -116,7 +125,6 @@ $nulnul = "\0" x 2;
 my $OP = $qr ? 'qr' : 'm';
 
 $| = 1;
-printf "1..%d\n# $iters iterations\n", scalar @tests;
 
 my $test;
 TEST:
@@ -132,6 +140,7 @@ foreach (@tests) {
     chomp;
     s/\\n/\n/g unless $regex_sets;
     my ($pat, $subject, $result, $repl, $expect, $reason, $comment) = split(/\t/,$_,7);
+    $comment = "" unless defined $comment;
     if (!defined $subject) {
         die "Bad test definition on line $test: $_\n";
     }
@@ -144,6 +153,11 @@ foreach (@tests) {
     $pat =~ s/\\n/\n/g unless $regex_sets;
     $pat = convert_from_ascii($pat) if ord("A") != 65;
 
+    my $no_null_pat;
+    if ($no_null && $pat =~ /^'(.*)'\z/) {
+       $no_null_pat = XS::APItest::string_without_null($1);
+    }
+
     $subject = convert_from_ascii($subject) if ord("A") != 65;
     $subject = eval qq("$subject"); die $@ if $@;
 
@@ -176,7 +190,42 @@ foreach (@tests) {
         $comment=~s/^\s*(?:#\s*)?//;
         $testname .= " - $comment" if $comment;
     }
-    if (! $skip && $regex_sets) {
+    if (! $skip && $alpha_assertions) {
+        my $assertions_re = qr/ (?: \Q(?\E (?: > | <? [=>] ) ) /x;
+        if ($pat !~ $assertions_re && $comment !~ $expanded_text_re) {
+            $skip++;
+            $reason = "Pattern doesn't contain assertions";
+        }
+        elsif ($comment !~ $expanded_text_re) {
+            my $expanded_pat = $pat;
+
+            $pat =~ s/\( \? > /(*atomic:/xg;
+
+            if ($pat =~ s/\( \? = /(*pla:/xg) {
+                $expanded_pat =~ s//(*positive_lookahead:/g;
+            }
+            if ($pat =~ s/\( \? ! /(*nla:/xg) {
+                $expanded_pat =~ s//(*negative_lookahead:/g;
+            }
+            if ($pat =~ s/\( \? <= /(*plb:/xg) {
+                $expanded_pat =~ s//(*positive_lookbehind:/g;
+            }
+            if ($pat =~ s/\( \? <! /(*nlb:/xg) {
+                $expanded_pat =~ s//(*negative_lookbehind:/g;
+            }
+            if ($expanded_pat ne $pat) {
+                $comment .= " $expanded_text $test";
+                push @tests, join "\t", $expanded_pat,
+                                        $subject // "",
+                                        $result // "",
+                                        $repl // "",
+                                        $expect // "",
+                                        $reason // "",
+                                        $comment;
+            }
+        }
+    }
+    elsif (! $skip && $regex_sets) {
 
         # If testing regex sets, change the [bracketed] classes into
         # (?[bracketed]).  But note that '\[' and '\c[' don't introduce such a
@@ -240,7 +289,8 @@ foreach (@tests) {
                             }
                         }
                         $j--;
-                        $modified .= substr($pat, $i + 1, $j - $i) . " ";
+                        $modified .= substr($pat, $i + 1, $j - $i);
+                        $modified .= " " if $in_brackets;
                         $i = $j;
                     }
                     elsif (ord($curchar) >= ord('0')
@@ -283,12 +333,8 @@ foreach (@tests) {
 
                 # A regular character.
                 if ($curchar ne '[') {
-                    if (! $in_brackets) {
-                        $modified .= $curchar;
-                    }
-                    else {
-                        $modified .= " $curchar ";
-                    }
+                    $modified .= " " if  $in_brackets;
+                    $modified .= $curchar;
                     next;
                 }
 
@@ -358,25 +404,28 @@ foreach (@tests) {
         }
     }
 
-    for my $study ('', 'study $subject', 'utf8::upgrade($subject)',
-		   'utf8::upgrade($subject); study $subject') {
+    for my $study ('', 'study $subject;', 'utf8::upgrade($subject);',
+		   'utf8::upgrade($subject); study $subject;') {
 	# Need to make a copy, else the utf8::upgrade of an already studied
 	# scalar confuses things.
 	my $subject = $subject;
+	$subject = XS::APItest::string_without_null($subject) if $no_null;
 	my $c = $iters;
 	my ($code, $match, $got);
         if ($repl eq 'pos') {
+            my $patcode = defined $no_null_pat ? '/$no_null_pat/g'
+                                               : "m${pat}g";
             $code= <<EOFCODE;
-                $study;
+                $study
                 pos(\$subject)=0;
-                \$match = ( \$subject =~ m${pat}g );
+                \$match = ( \$subject =~ $patcode );
                 \$got = pos(\$subject);
 EOFCODE
         }
         elsif ($qr_embed) {
             $code= <<EOFCODE;
                 my \$RE = qr$pat;
-                $study;
+                $study
                 \$match = (\$subject =~ /(?:)\$RE(?:)/) while \$c--;
                 \$got = "$repl";
 EOFCODE
@@ -386,19 +435,29 @@ EOFCODE
 		# Can't run the match in a subthread, but can do this and
 	 	# clone the pattern the other way.
                 my \$RE = threads->new(sub {qr$pat})->join();
-                $study;
+                $study
                 \$match = (\$subject =~ /(?:)\$RE(?:)/) while \$c--;
                 \$got = "$repl";
 EOFCODE
         }
+        elsif ($no_null) {
+            my $patcode = defined $no_null_pat ? '/$no_null_pat/'
+                                               :  $pat;
+            $code= <<EOFCODE;
+                $study
+                \$match = (\$subject =~ $OP$pat) while \$c--;
+                \$got = "$repl";
+EOFCODE
+        }
         else {
             $code= <<EOFCODE;
-                $study;
+                $study
                 \$match = (\$subject =~ $OP$pat) while \$c--;
                 \$got = "$repl";
 EOFCODE
         }
         $code = "no warnings 'experimental::regex_sets';$code" if $regex_sets;
+        $code = "no warnings 'experimental::alpha_assertions';$code" if $alpha_assertions;
         #$code.=qq[\n\$expect="$expect";\n];
         #use Devel::Peek;
         #die Dump($code) if $pat=~/\\h/ and $subject=~/\x{A0}/;
@@ -442,7 +501,8 @@ EOFCODE
 		else { # better diagnostics
 		    my $s = Data::Dumper->new([$subject],['subject'])->Useqq(1)->Dump;
 		    my $g = Data::Dumper->new([$got],['got'])->Useqq(1)->Dump;
-		    print "not ok $testname$todo ($study) $input => '$got', match=$match\n", _comment("$s\n$g\n$code\n");
+		    my $e = Data::Dumper->new([$expect],['expected'])->Useqq(1)->Dump;
+		    print "not ok $testname$todo ($study) $input => '$got', match=$match\n", _comment("$s\n$code\n$g\n$e\n");
 		}
 		next TEST;
 	    }
@@ -451,4 +511,6 @@ EOFCODE
     print "ok $testname$todo\n";
 }
 
+printf "1..%d\n# $iters iterations\n", scalar @tests;
+
 1;