summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorKarl Williamson <khw@cpan.org>2018-12-22 12:14:38 -0700
committerKarl Williamson <khw@cpan.org>2018-12-25 09:08:10 -0700
commit542d7e4abd75683a540c4f4b2680400a659fff68 (patch)
treef4d23d27be52839e8404a2a3be3f3fb1dde4c701 /t
parent87cafc451fd288662c07600d10523c676c8b56ef (diff)
downloadperl-542d7e4abd75683a540c4f4b2680400a659fff68.tar.gz
re/anyof.t: Extract code into a function
This is in preparation for a future commit where it will be used in more than one place.
Diffstat (limited to 't')
-rw-r--r--t/re/anyof.t94
1 files changed, 51 insertions, 43 deletions
diff --git a/t/re/anyof.t b/t/re/anyof.t
index 38400b17cd..99cf522baa 100644
--- a/t/re/anyof.t
+++ b/t/re/anyof.t
@@ -35,6 +35,55 @@ BEGIN {
# NOTE: If the pattern contains (?8) it will be upgraded to UTF-8 after
# stripping that
+# 2**32-1 or 2**64-1
+my $highest_cp_string = "F" x (($Config{uvsize} < 8) ? 8 : 16);
+
+my $next_highest_cp_string = $highest_cp_string =~ s/ F $ /E/xr;
+
+my $highest_cp = "\\x{$highest_cp_string}";
+my $next_highest_cp = "\\x{$next_highest_cp_string}";
+
+sub get_compiled ($) {
+ # Convert platform-independent values to what is suitable for the
+ # platform
+
+ my $pattern = shift;
+
+ $pattern =~ s/\{INFTY\}/$highest_cp/g;
+ $pattern =~ s/\{INFTY_minus_1\}/$next_highest_cp/g;
+ my $use_utf8 = ($pattern =~ s/\Q(?8)//);
+
+ $pattern = "my \$a = '$pattern';";
+ $pattern .= "utf8::upgrade(\$a);" if $use_utf8;
+ $pattern .= "qr/\$a/";
+ my $actual_pattern = "use re qw(Debug COMPILE); $pattern";
+
+ my $result = fresh_perl($actual_pattern);
+ if ($? != 0) { # Re-run so as to display STDERR.
+ fail($pattern);
+ fresh_perl($actual_pattern, { stderr => 0, verbose => 1 });
+ return;
+ }
+
+ # The Debug output will come back as a bunch of lines. We are
+ # interested only in the line after /Final program/
+ my @lines = split /\n/, $result;
+ while (defined ($_ = shift @lines)) {
+ last if /Final program/;
+ }
+
+ $_ = shift @lines;
+
+ s/ \s* \( \d+ \) \s* //x; # Get rid of the node branch
+ s/ ^ \s* \d+ : \s* //x; # ... And the node number
+
+ # Use platform-independent values
+ s/$highest_cp_string/INFTY/g;
+ s/$next_highest_cp_string/INFTY_minus_1/g;
+
+ return $_;
+}
+
my @tests = (
'[[{]' => 'ANYOFM[\[\{]',
'[^\S ]' => 'ANYOFD[\t\n\x0B\f\r{utf8}\x85\xA0][1680 2000-200A 2028-2029 202F 205F 3000]',
@@ -311,14 +360,6 @@ my @tests = (
'[\x{10C}-{INFTY}\x{102}-\x{104}\x{106}]' => 'ANYOF[0102-0104 0106 010C-INFTY]',
);
-# 2**32-1 or 2**64-1
-my $highest_cp_string = "F" x (($Config{uvsize} < 8) ? 8 : 16);
-
-my $next_highest_cp_string = $highest_cp_string =~ s/ F $ /E/xr;
-
-my $highest_cp = "\\x{$highest_cp_string}";
-my $next_highest_cp = "\\x{$next_highest_cp_string}";
-
plan(scalar (@tests - 1) / 2); # -1 because of the marker.
my $skip_ebcdic = $::IS_EBCDIC;
@@ -337,41 +378,8 @@ while (defined (my $test = shift @tests)) {
my $display_expected = $expected
=~ s/ INFTY_minus_1 /$next_highest_cp/xgr;
- # Convert platform-independent values to what is suitable for the
- # platform
- $test =~ s/\{INFTY\}/$highest_cp/g;
- $test =~ s/\{INFTY_minus_1\}/$next_highest_cp/g;
- my $use_utf8 = ($test =~ s/\Q(?8)//);
-
- $test = "my \$a = '$test';";
- $test .= "utf8::upgrade(\$a);" if $use_utf8;
- $test .= "qr/\$a/";
- my $actual_test = "use re qw(Debug COMPILE); $test";
-
- my $result = fresh_perl($actual_test);
- if ($? != 0) { # Re-run so as to display STDERR.
- fail($test);
- fresh_perl($actual_test, { stderr => 0, verbose => 1 });
- next;
- }
-
- # The Debug output will come back as a bunch of lines. We are
- # interested only in the line after /Final program/
- my @lines = split /\n/, $result;
- while (defined ($_ = shift @lines)) {
- next unless /Final program/;
- $_ = shift @lines;
-
- s/ \s* \( \d+ \) \s* //x; # Get rid of the node branch
- s/ ^ \s* \d+ : \s* //x; # ... And the node number
-
- # Use platform-independent values
- s/$highest_cp_string/INFTY/g;
- s/$next_highest_cp_string/INFTY_minus_1/g;
-
- is($_, $expected,
+ my $result = get_compiled($test);
+ is($result, $expected,
"Verify compilation of $test displays as $display_expected");
- last; # Discard the rest of this test's output
- }
}
}