From cb79f740dae4d41cfe556ac0e57a6e7afcd0fb6f Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 13 Mar 2011 19:08:57 +0000
Subject: Convert t/re/reg_mesg.t to test.pl and strict.

This reduces its line count by 25%, with no loss of functionality.
(It actually tests slightly more, specifically that the regexps in @death don't
generate warnings, just die.)
---
 t/re/reg_mesg.t | 119 +++++++++++++++-----------------------------------------
 1 file changed, 32 insertions(+), 87 deletions(-)

(limited to 't/re')

diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 80af8df3dd..74b264a137 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -3,27 +3,32 @@
 BEGIN {
 	chdir 't' if -d 't';
 	@INC = '../lib';
+	require './test.pl';
+	eval 'require Config'; # assume defaults if this fails
 }
 
-my $debug = 1;
+use strict;
 
 ##
 ## If the markers used are changed (search for "MARKER1" in regcomp.c),
-## update only these two variables, and leave the {#} in the @death/@warning
+## update only these two regexs, and leave the {#} in the @death/@warning
 ## arrays below. The {#} is a meta-marker -- it marks where the marker should
 ## go.
+##
+sub fixup_expect {
+    my $expect = shift;
+    $expect =~ s/{\#}/<-- HERE/;
+    $expect =~ s/{\#}/ <-- HERE /;
+    $expect .= " at ";
+    return $expect;
+}
 
-my $marker1 = "<-- HERE";
-my $marker2 = " <-- HERE ";
+my $inf_m1 = ($Config::Config{reg_infty} || 32767) - 1;
+my $inf_p1 = $inf_m1 + 2;
 
 ##
 ## Key-value pairs of code/error of code that should have fatal errors.
 ##
-
-eval 'use Config';         # assume defaults if fail
-our %Config;
-my $inf_m1 = ($Config{reg_infty} || 32767) - 1;
-my $inf_p1 = $inf_m1 + 2;
 my @death =
 (
  '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=foo=]{#}]/',
@@ -102,7 +107,7 @@ my @death =
 ##
 ## Key-value pairs of code/error of code that should have non-fatal warnings.
 ##
-@warning = (
+my @warning = (
     'm/\b*/' => '\b* matches null string many times in regex; marked by {#} in m/\b*{#}/',
 
     'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes in regex; marked by {#} in m/[:blank:]{#}/',
@@ -116,85 +121,25 @@ my @death =
     "m'\\y'"     => 'Unrecognized escape \y passed through in regex; marked by {#} in m/\y{#}/',
 );
 
-my $total = (@death + @warning)/2;
-
-# utf8 is a noop on EBCDIC platforms, it is not fatal
-my $Is_EBCDIC = (ord('A') == 193);
-if ($Is_EBCDIC) {
-    my @utf8_death = grep(/utf8/, @death); 
-    $total = $total - @utf8_death;
-}
-
-print "1..$total\n";
-
-my $count = 0;
-
-while (@death)
-{
-    my $regex = shift @death;
-    my $result = shift @death;
+while (my ($regex, $expect) = splice @death, 0, 2) {
+    my $expect = fixup_expect($expect);
     # skip the utf8 test on EBCDIC since they do not die
-    next if ($Is_EBCDIC && $regex =~ /utf8/);
-    $count++;
-
-    $_ = "x";
-    eval $regex;
-    if (not $@) {
-	print "# oops, $regex didn't die\nnot ok $count\n";
-	next;
-    }
-    chomp $@;
-    $result =~ s/{\#}/$marker1/;
-    $result =~ s/{\#}/$marker2/;
-    $result .= " at ";
-    if ($@ !~ /^\Q$result/) {
-	print "# For $regex, expected:\n#  $result\n# Got:\n#  $@\n#\nnot ";
-    }
-    print "ok $count - $regex\n";
-}
+    next if $::IS_EBCDIC && $regex =~ /utf8/;
 
-
-our $warning;
-$SIG{__WARN__} = sub { $warning = shift };
-
-while (@warning)
-{
-    $count++;
-    my $regex = shift @warning;
-    my $result = shift @warning;
-
-    undef $warning;
-    $_ = "x";
-    eval $regex;
-
-    if ($@)
-    {
-	print "# oops, $regex died with:\n#\t$@#\nnot ok $count\n";
-	next;
-    }
-
-    if (not $warning)
-    {
-	print "# oops, $regex didn't generate a warning\nnot ok $count\n";
-	next;
-    }
-    $result =~ s/{\#}/$marker1/;
-    $result =~ s/{\#}/$marker2/;
-    $result .= " at ";
-    if ($warning !~ /^\Q$result/)
-    {
-	print <<"EOM";
-# For $regex, expected:
-#   $result
-# Got:
-#   $warning
-#
-not ok $count
-EOM
-	next;
-    }
-    print "ok $count - $regex\n";
+    warning_is(sub {
+		   $_ = "x";
+		   eval $regex;
+		   like($@, qr/\Q$expect/);
+	       }, undef, "$regex died without any other warnings");
 }
 
+while (my ($regex, $expect) = splice @warning, 0, 2) {
+    my $expect = fixup_expect($expect);
+    warning_like(sub {
+		     $_ = "x";
+		     eval $regex;
+		     is($@, '', "$regex did not die");
+		 }, qr/\Q$expect/);
+}
 
-
+done_testing();
-- 
cgit v1.2.1