In ReTest.pl, provide is(), isnt(), like() and unlike(), equivalent to test.pl

[perl5.git] / t / re / ReTest.pl

diff --git a/t/re/ReTest.pl b/t/re/ReTest.pl
index 0c08e25..561c36b 100644 (file)
--- a/t/re/ReTest.pl
+++ b/t/re/ReTest.pl
@@ -119,29 +119,65 @@ sub skip {
 }
 
 sub iseq ($$;$) { 
-    my ($got, $expect, $name) = @_;
-    
-    $_ = defined ($_) ? "'$_'" : "undef" for $got, $expect;
-        
-    my $ok    = $got eq $expect;
-    my $error = "# expected: $expect\n" .
+    my ($got, $expected, $name) = @_;
+
+    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 $ok, $name, $error;
+    _ok $pass, $name, $error;
 }   
 
 sub isneq ($$;$) { 
-    my ($got, $expect, $name) = @_;
-    my $todo = $TODO ? " # TODO $TODO" : '';
-    
-    $_ = defined ($_) ? "'$_'" : "undef" for $got, $expect;
-        
-    my $ok    = $got ne $expect;
+    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 $ok, $name, $error;
+    _ok $pass, $name, $error;
 }   
 
+*is = \&iseq;
+*isnt = \&isneq;
+
+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 eval_ok ($;$) {
     my ($code, $name) = @_;
@@ -172,7 +208,7 @@ sub must_warn {
     ref $code ? &$code : eval $code;
     my $r = $w && $w =~ /$pattern/;
     $w //= "UNDEF";
-    _ok $r, $name // $Message // "Got warning /$pattern/",
+    _ok $r, $name // "Got warning /$pattern/",
             "# expected: /$pattern/\n" .
             "#   result: $w";
 }
@@ -183,9 +219,7 @@ sub may_not_warn {
     local $SIG {__WARN__} = sub {$w .= join "" => @_};
     use warnings 'all';
     ref $code ? &$code : eval $code;
-    _ok !$w, $name // ($Message ? "$Message (did not warn)"
-                                : "Did not warn"),
-             "Got warning '$w'";
+    _ok !$w, $name, "Got warning '$w'";
 }
 
 1;