This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
no_plan support in test.pl
[perl5.git] / t / test.pl
index 52fefbf..56bf355 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -5,6 +5,7 @@
 $Level = 1;
 my $test = 1;
 my $planned;
+my $noplan;
 
 $TODO = 0;
 $NO_ENDING = 0;
@@ -13,18 +14,27 @@ sub plan {
     my $n;
     if (@_ == 1) {
        $n = shift;
+       if ($n eq 'no_plan') {
+         undef $n;
+         $noplan = 1;
+       }
     } else {
        my %plan = @_;
        $n = $plan{tests}; 
     }
-    print STDOUT "1..$n\n";
+    print STDOUT "1..$n\n" unless $noplan;
     $planned = $n;
 }
 
 END {
     my $ran = $test - 1;
-    if (!$NO_ENDING && defined $planned && $planned != $ran) {
-        print STDERR "# Looks like you planned $planned tests but ran $ran.\n";
+    if (!$NO_ENDING) {
+       if (defined $planned && $planned != $ran) {
+           print STDERR
+               "# Looks like you planned $planned tests but ran $ran.\n";
+       } elsif ($noplan) {
+           print "1..$ran\n";
+       }
     }
 }
 
@@ -235,21 +245,18 @@ sub within ($$$@) {
 }
 
 # Note: this isn't quite as fancy as Test::More::like().
-sub like ($$@) {
-    my ($got, $expected, $name, @mess) = @_;
+
+sub like   ($$@) { like_yn (0,@_) }; # 0 for -
+sub unlike ($$@) { like_yn (1,@_) }; # 1 for un-
+
+sub like_yn ($$$@) {
+    my ($flip, $got, $expected, $name, @mess) = @_;
     my $pass;
-    if (ref $expected eq 'Regexp') {
-       $pass = $got =~ $expected;
-       unless ($pass) {
-           unshift(@mess, "#      got '$got'\n",
-                          "# expected /$expected/\n");
-       }
-    } else {
-       $pass = $got =~ /$expected/;
-       unless ($pass) {
-           unshift(@mess, "#      got '$got'\n",
-                          "# expected /$expected/\n");
-       }
+    $pass = $got =~ /$expected/ if !$flip;
+    $pass = $got !~ /$expected/ if $flip;
+    unless ($pass) {
+       unshift(@mess, "#      got '$got'\n",
+               "# expected /$expected/\n");
     }
     _ok($pass, _where(), $name, @mess);
 }
@@ -379,12 +386,19 @@ sub _create_runperl { # Create the string to qx in runperl().
        }
     }
     if ($args{switches}) {
+       local $Level = 2;
+       die "test.pl:runperl(): 'switches' must be an ARRAYREF " . _where()
+           unless ref $args{switches} eq "ARRAY";
        _quote_args(\$runperl, $args{switches});
     }
     if (defined $args{prog}) {
+       die "test.pl:runperl(): both 'prog' and 'progs' cannot be used " . _where()
+           if defined $args{progs};
         $args{progs} = [$args{prog}]
     }
     if (defined $args{progs}) {
+       die "test.pl:runperl(): 'progs' must be an ARRAYREF " . _where()
+           unless ref $args{progs} eq "ARRAY";
         foreach my $prog (@{$args{progs}}) {
             if ($is_mswin || $is_netware || $is_vms) {
                 $runperl .= qq ( -e "$prog" );
@@ -579,7 +593,7 @@ sub _fresh_perl {
 }
 
 #
-# run_perl_is
+# fresh_perl_is
 #
 # Combination of run_perl() and is().
 #
@@ -593,7 +607,7 @@ sub fresh_perl_is {
 }
 
 #
-# run_perl_like
+# fresh_perl_like
 #
 # Combination of run_perl() and like().
 #