From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 4 Mar 2011 22:32:24 +0000 (+0000)
Subject: Refactor ReTest.pl to use test.pl for testing functions and TAP generation.
X-Git-Tag: v5.13.11~305
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/df74e34d4e5a1f53dd14124de485e098573cb58a?ds=sidebyside

Refactor ReTest.pl to use test.pl for testing functions and TAP generation.

Provide compatibility implementations of nok(), and iseq(), which will be
removed once their callers are refactored. Eliminate isneq(), which is now
unused.
---

diff --git a/t/re/ReTest.pl b/t/re/ReTest.pl
index 2d77a1c..4546431 100644
--- a/t/re/ReTest.pl
+++ b/t/re/ReTest.pl
@@ -8,9 +8,6 @@ use 5.010;
 use base qw/Exporter/;
 use Carp;
 use vars qw(
-    $EXPECTED_TESTS 
-    $TODO
-    $running_as_thread
     $IS_ASCII
     $IS_EBCDIC
     $ordA
@@ -26,166 +23,23 @@ our $IS_EBCDIC = $ordA == 193;
 use vars '%Config';
 eval 'use Config';          #  Defaults assumed if this fails
 
-my $test = 0;
-my $done_plan;
-sub plan {
-    my (undef,$tests)= @_;
-    if (defined $tests) {
-        die "Number of tests already defined! ($EXPECTED_TESTS)"
-            if $EXPECTED_TESTS;
-        $EXPECTED_TESTS= $tests;
-    }
-    if ($EXPECTED_TESTS) {
-        print "1..$EXPECTED_TESTS\n" if !$done_plan++;
-    } else {
-        print "Number of tests not declared!";
-    }
-}
-
-sub pretty {
-    my ($mess) = @_;
-    return unless defined $mess;
-    $mess =~ s/\n/\\n/g;
-    $mess =~ s/\r/\\r/g;
-    $mess =~ s/\t/\\t/g;
-    $mess =~ s/([\00-\37\177])/sprintf '\%03o', ord $1/eg;
-    $mess =~ s/#/\\#/g;
-    $mess;
-}
-
-sub safe_globals {
-    defined($_) and s/#/\\#/g for $TODO;
-}
-
-sub _ok {
-    my ($ok, $mess, $error) = @_;
-    plan();
-    safe_globals();
-    $mess    = defined $mess ? pretty ($mess) : 'Noname test';
-    $mess   .= " # TODO $TODO"     if defined $TODO;
-
-    my $line_nr = (caller(1)) [2];
-
-    printf "%sok %d - %s\n",
-              ($ok ? "" : "not "),
-              ++ $test,
-              $mess;
-
-    unless ($ok) {
-        print "# Failed test at line $line_nr\n" unless defined $TODO;
-        if ($error) {
-            no warnings 'utf8';
-            chomp $error;
-            $error = join "\n#", map {pretty $_} split /\n\h*#/ => $error;
-            $error = "# $error" unless $error =~ /^\h*#/;
-            print $error, "\n";
-        }
-    }
-
-    return $ok;
-}
-
-# Force scalar context on the pattern match
-sub  ok ($;$$) {_ok  $_ [0], $_ [1], $_ [2]}
-sub nok ($;$$) {_ok !$_ [0], "Failed: " . $_ [1], $_ [2]}
-
-
-sub skip {
-    my $why = shift;
-    safe_globals();
-    $why =~ s/\n.*//s;
-    my $ok;
-    if (defined $TODO) {
-	$why = "TODO & SKIP $why $TODO";
-	$ok = "not ok";
-    } else {
-	$why = "SKIP $why";
-	$ok = "ok";
-    }
-
-    my $n = shift // 1;
-    my $line_nr = (caller(0)) [2];
-    for (1 .. $n) {
-        ++ $test;
-        print "$ok $test # $why\tLine $line_nr\n";
-    }
-    no warnings "exiting";
-    last SKIP;
-}
+require './test.pl';
 
-sub iseq ($$;$) { 
-    my ($got, $expected, $name) = @_;
+*iseq = \&is;
 
-    my $pass;
-    if(!defined $got || !defined $expected) {
-        # undef only matches undef
-        $pass = !defined $got && !defined $expected;
-    }
-    else {
-        $pass = $got eq $expected;
-    }
-
-    $_ = defined ($_) ? "'$_'" : "undef" for $got, $expected;
-
-    my $error = "# expected: $expected\n" .
-                "#   result: $got";
-
-    _ok $pass, $name, $error;
-}   
-
-sub isneq ($$;$) { 
-    my ($got, $isnt, $name) = @_;
-
-    my $pass;
-    if(!defined $got || !defined $isnt) {
-        # undef only matches undef
-        $pass = defined $got || defined $isnt;
-    }
-    else {
-        $pass = $got ne $isnt;
-    }
-
-    $got = defined $got ? "'$got'" : "undef";
-    my $error = "# results are equal ($got)";
-
-    _ok $pass, $name, $error;
-}   
-
-*is = \&iseq;
-*isnt = \&isneq;
-
-sub diag {
-    print STDERR "# $_[0]\n";
-}
-
-sub like ($$$) {
-    my (undef, $expected, $name) = @_;
-    my ($pass, $error);
-    $pass = $_[0] =~ /$expected/;
-    unless ($pass) {
-	$error = "#      got '$_[0]'\n# expected /$expected/";
-    }
-    _ok($pass, $name, $error);
-}
-
-sub unlike ($$$) {
-    my (undef, $expected, $name) = @_;
-    my ($pass, $error);
-    $pass = $_[0] !~ /$expected/;
-    unless ($pass) {
-	$error = "#      got '$_[0]'\n# expected !~ /$expected/";
-    }
-    _ok($pass, $name, $error);
+sub nok ($;$$) {
+    my $bool = shift;
+    ok(!$bool, @_);
 }
 
 sub eval_ok ($;$) {
     my ($code, $name) = @_;
     local $@;
     if (ref $code) {
-        _ok eval {&$code} && !$@, $name;
+        ok(eval {&$code} && !$@, $name);
     }
     else {
-        _ok eval  ($code) && !$@, $name;
+        ok(eval  ($code) && !$@, $name);
     }
 }
 
@@ -194,8 +48,7 @@ sub must_die {
     Carp::confess("Bad pattern") unless $pattern;
     undef $@;
     ref $code ? &$code : eval $code;
-    my  $r = $@ && $@ =~ /$pattern/;
-    _ok $r, $name // "\$\@ =~ /$pattern/";
+    like($@, $pattern, $name // "\$\@ =~ /$pattern/");
 }
 
 sub must_warn {
@@ -205,11 +58,7 @@ sub must_warn {
     local $SIG {__WARN__} = sub {$w .= join "" => @_};
     use warnings 'all';
     ref $code ? &$code : eval $code;
-    my $r = $w && $w =~ /$pattern/;
-    $w //= "UNDEF";
-    _ok $r, $name // "Got warning /$pattern/",
-            "# expected: /$pattern/\n" .
-            "#   result: $w";
+    like($w, qr/$pattern/, "Got warning /$pattern/");
 }
 
 sub may_not_warn {
@@ -218,7 +67,7 @@ sub may_not_warn {
     local $SIG {__WARN__} = sub {$w .= join "" => @_};
     use warnings 'all';
     ref $code ? &$code : eval $code;
-    _ok !$w, $name, "Got warning '$w'";
+    is($w, undef, $name) or diag("Got warning '$w'");
 }
 
 1;