X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Ftest.pl;h=735d96653325d2e557ceae465e134eddd8192f84;hb=d2be0de5a5030be3ee411cadf9db630bb6fd8a4a;hp=91daf1ae1b5b046db17e09a604c08439151c31d3;hpb=58d76dfdf30230046d41beb912124c3381ef2bc8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/test.pl b/t/test.pl
index 91daf1a..735d966 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -30,13 +30,17 @@ END {
 # Use this instead of "print STDERR" when outputing failure diagnostic 
 # messages
 sub _diag {
+    return unless @_;
+    my @mess = map { /^#/ ? "$_\n" : "# $_\n" } 
+               map { split /\n/ } @_;
     my $fh = $TODO ? *STDOUT : *STDERR;
-    print $fh @_;
+    print $fh @mess;
+
 }
 
 sub skip_all {
     if (@_) {
-	print STDOUT "1..0 - @_\n";
+	print STDOUT "1..0 # Skipped: @_\n";
     } else {
 	print STDOUT "1..0\n";
     }
@@ -64,8 +68,7 @@ sub _ok {
     }
 
     # Ensure that the message is properly escaped.
-    _diag map { /^#/ ? "$_\n" : "# $_\n" } 
-          map { split /\n/ } @mess if @mess;
+    _diag @mess;
 
     $test++;
 
@@ -130,7 +133,16 @@ sub display {
 
 sub is {
     my ($got, $expected, $name, @mess) = @_;
-    my $pass = $got eq $expected;
+
+    my $pass;
+    if( !defined $got || !defined $expected ) {
+        # undef only matches undef
+        $pass = !defined $got && !defined $expected;
+    }
+    else {
+        $pass = $got eq $expected;
+    }
+
     unless ($pass) {
 	unshift(@mess, "#      got "._q($got)."\n",
 		       "# expected "._q($expected)."\n");
@@ -140,7 +152,16 @@ sub is {
 
 sub isnt {
     my ($got, $isnt, $name, @mess) = @_;
-    my $pass = $got ne $isnt;
+
+    my $pass;
+    if( !defined $got || !defined $isnt ) {
+        # undef only matches undef
+        $pass = defined $got || defined $isnt;
+    }
+    else {
+        $pass = $got ne $isnt;
+    }
+
     unless( $pass ) {
         unshift(@mess, "# it should not be "._q($got)."\n",
                        "# but it is.\n");
@@ -241,11 +262,12 @@ sub fail {
 }
 
 sub curr_test {
+    $test = shift if @_;
     return $test;
 }
 
 sub next_test {
-    $test++
+  $test++;
 }
 
 # Note: can't pass multipart messages since we try to
@@ -319,6 +341,7 @@ USE_OK
 #   switches => [ command-line switches ]
 #   nolib    => 1 # don't use -I../lib (included by default)
 #   prog     => one-liner (avoid quotes)
+#   progs    => [ multi-liner (avoid quotes) ]
 #   progfile => perl script
 #   stdin    => string to feed the stdin
 #   stderr   => redirect stderr to stdout
@@ -344,9 +367,6 @@ sub _quote_args {
 sub runperl {
     my %args = @_;
     my $runperl = $^X;
-    if ($args{switches}) {
-	_quote_args(\$runperl, $args{switches});
-    }
     unless ($args{nolib}) {
 	if ($is_macos) {
 	    $runperl .= ' -I::lib';
@@ -357,26 +377,47 @@ sub runperl {
 	    $runperl .= ' "-I../lib"'; # doublequotes because of VMS
 	}
     }
+    if ($args{switches}) {
+	_quote_args(\$runperl, $args{switches});
+    }
     if (defined $args{prog}) {
-	if ($is_mswin || $is_netware || $is_vms) {
-	    $runperl .= qq( -e ") . $args{prog} . qq(");
-	}
-	else {
-	    $runperl .= qq( -e ') . $args{prog} . qq(');
-	}
+        $args{progs} = [$args{prog}]
+    }
+    if (defined $args{progs}) {
+        foreach my $prog (@{$args{progs}}) {
+            if ($is_mswin || $is_netware || $is_vms) {
+                $runperl .= qq ( -e "$prog" );
+            }
+            else {
+                $runperl .= qq ( -e '$prog' );
+            }
+        }
     } elsif (defined $args{progfile}) {
 	$runperl .= qq( "$args{progfile}");
     }
     if (defined $args{stdin}) {
-        # so we don't try to put literal newlines and crs onto the
-        # command line.
-        $args{stdin} =~ s/\n/\\n/g;
-        $args{stdin} =~ s/\r/\\r/g;
+	# so we don't try to put literal newlines and crs onto the
+	# command line.
+	$args{stdin} =~ s/\n/\\n/g;
+	$args{stdin} =~ s/\r/\\r/g;
 
 	if ($is_mswin || $is_netware || $is_vms) {
 	    $runperl = qq{$^X -e "print qq(} .
 		$args{stdin} . q{)" | } . $runperl;
 	}
+	elsif ($is_macos) {
+	    # MacOS can only do two processes under MPW at once;
+	    # the test itself is one; we can't do two more, so
+	    # write to temp file
+	    my $stdin = qq{$^X -e 'print qq(} . $args{stdin} . qq{)' > teststdin; };
+	    if ($args{verbose}) {
+		my $stdindisplay = $stdin;
+		$stdindisplay =~ s/\n/\n\#/g;
+		print STDERR "# $stdindisplay\n";
+	    }
+	    `$stdin`;
+	    $runperl .= q{ < teststdin };
+	}
 	else {
 	    $runperl = qq{$^X -e 'print qq(} .
 		$args{stdin} . q{)' | } . $runperl;
@@ -397,6 +438,7 @@ sub runperl {
     return $result;
 }
 
+*run_perl = \&runperl; # Nice alias.
 
 sub DIE {
     print STDERR "# @_\n";
@@ -409,6 +451,9 @@ sub which_perl {
     unless (defined $Perl) {
 	$Perl = $^X;
 	
+	# VMS should have 'perl' aliased properly
+	return $Perl if $^O eq 'VMS';
+
 	my $exe;
 	eval "require Config; Config->import";
 	if ($@) {
@@ -512,10 +557,10 @@ sub _fresh_perl {
 
     my $pass = $resolve->($results);
     unless ($pass) {
-        print STDERR "# PROG: $switch\n$prog\n";
-        print STDERR "# EXPECTED:\n", $resolve->(), "\n";
-        print STDERR "# GOT:\n$results\n";
-        print STDERR "# STATUS: $status\n";
+        _diag "# PROG: \n$prog\n";
+        _diag "# EXPECTED:\n", $resolve->(), "\n";
+        _diag "# GOT:\n$results\n";
+        _diag "# STATUS: $status\n";
     }
 
     # Use the first line of the program as a name if none was given