Migrate t/op/{fork,runlevel,tie}.t to use run_multiple_progs().
authorNicholas Clark <nick@ccl4.org>
Thu, 24 Feb 2011 16:46:49 +0000 (16:46 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 25 Feb 2011 07:59:51 +0000 (07:59 +0000)
The addition of "OPTION random" to all fork.t's tests might be overkill, given
that run_multiple_progs() can specify "random" per test, but as the previous
code in fork.t always sorted before comparison, we are no *worse* off than we
were.

t/lib/common.pl
t/op/fork.t
t/op/runlevel.t
t/op/tie.t
t/test.pl

index d5780b6..34a8723 100644 (file)
@@ -74,6 +74,6 @@ my $tests = $::local_tests || 0;
 $tests = scalar(@prgs)-$files + $tests if $tests !~ /\D/;
 plan $tests;    # If input is 'no_plan', pass it on unchanged
 
-run_multiple_progs(@prgs);
+run_multiple_progs('../..', @prgs);
 
 1;
index fc9c58f..d1b6e5b 100644 (file)
@@ -21,55 +21,9 @@ if ($^O eq 'mpeix') {
 
 $|=1;
 
-undef $/;
-@prgs = split "\n########\n", <DATA>;
-print "1..", scalar @prgs, "\n";
+run_multiple_progs('', \*DATA);
 
-$tmpfile = tempfile();
-END { close TEST }
-
-$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : (($^O eq 'NetWare') ? 'perl -e "print <>"' : 'cat'));
-
-for (@prgs){
-    my $switch;
-    if (s/^\s*(-\w.*)//){
-       $switch = $1;
-    }
-    my($prog,$expected) = split(/\nEXPECT\n/, $_);
-    $expected =~ s/\n+$//;
-    # results can be in any order, so sort 'em
-    my @expected = sort split /\n/, $expected;
-    open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
-    print TEST $prog, "\n";
-    close TEST or die "Cannot close $tmpfile: $!";
-    my $results;
-    if ($^O eq 'MSWin32') {
-      $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
-    }
-    elsif ($^O eq 'NetWare') {
-      $results = `perl -I../lib $switch $tmpfile 2>&1`;
-    }
-    else {
-      $results = `./perl $switch $tmpfile 2>&1`;
-    }
-    $status = $?;
-    $results =~ s/\n+$//;
-    $results =~ s/at\s+$::tempfile_regexp\s+line/at - line/g;
-    $results =~ s/of\s+$::tempfile_regexp\s+aborted/of - aborted/g;
-# bison says 'parse error' instead of 'syntax error',
-# various yaccs may or may not capitalize 'syntax'.
-    $results =~ s/^(syntax|parse) error/syntax error/mig;
-    $results =~ s/^\n*Process terminated by SIG\w+\n?//mg
-       if $^O eq 'os2';
-    my @results = sort split /\n/, $results;
-    if ( "@results" ne "@expected" ) {
-       print STDERR "PROG: $switch\n$prog\n";
-       print STDERR "EXPECTED:\n$expected\n";
-       print STDERR "GOT:\n$results\n";
-       print "not ";
-    }
-    print "ok ", ++$i, "\n";
-}
+done_testing();
 
 __END__
 $| = 1;
@@ -88,6 +42,7 @@ else {
     sleep 10;
 }
 EXPECT
+OPTION random
 ok 1
 ok 2
 ########
@@ -106,6 +61,7 @@ else {
     die;
 }
 EXPECT
+OPTION random
 ok 1
 ok 2
 ########
@@ -127,6 +83,7 @@ sub forkit {
 }
 while ($i++ < 3) { do { forkit(); }; }
 EXPECT
+OPTION random
 iteration 1 start
 iteration 1 parent
 iteration 1 child
@@ -154,6 +111,7 @@ fork()
  ? (print("parent\n"),sleep(1))
  : (print("child\n"),exit) ;
 EXPECT
+OPTION random
 parent
 child
 ########
@@ -162,6 +120,7 @@ fork()
  ? (print("parent\n"),exit)
  : (print("child\n"),sleep(1)) ;
 EXPECT
+OPTION random
 parent
 child
 ########
@@ -179,6 +138,7 @@ for (@a) {
 }
 print "@a\n";
 EXPECT
+OPTION random
 parent 1
 child 1
 parent 2
@@ -214,6 +174,7 @@ foreach my $c (1,2,3) {
 }
 while (wait() != -1) { print "waited\n" }
 EXPECT
+OPTION random
 child 1
 child 2
 child 3
@@ -231,6 +192,7 @@ fork()
  ? print($Config{osname} eq $^O)
  : print($Config{osname} eq $^O) ;
 EXPECT
+OPTION random
 1
 1
 ########
@@ -240,6 +202,7 @@ fork()
  ? do { require Config; print($Config::Config{osname} eq $^O); }
  : do { require Config; print($Config::Config{osname} eq $^O); }
 EXPECT
+OPTION random
 1
 1
 ########
@@ -266,6 +229,7 @@ else {
     rmdir $dir;
 }
 EXPECT
+OPTION random
 ok 1 parent
 ok 1 child
 ########
@@ -291,6 +255,7 @@ else {
     print "child after: " . `$getenv`;
 }
 EXPECT
+OPTION random
 child before: foo
 child after: baz
 parent before: foo
@@ -306,6 +271,7 @@ else {
     exit(42);
 }
 EXPECT
+OPTION random
 parent got 10752
 ########
 $| = 1;
@@ -319,6 +285,7 @@ else {
     exec("$echo foo");
 }
 EXPECT
+OPTION random
 foo
 parent got 0
 ########
@@ -329,6 +296,7 @@ else {
     die "child died";
 }
 EXPECT
+OPTION random
 parent died at - line 2.
 child died at - line 5.
 ########
@@ -341,6 +309,7 @@ else {
     print $@;
 }
 EXPECT
+OPTION random
 parent died at - line 2.
 child died at - line 6.
 ########
@@ -353,6 +322,7 @@ else {
     print $@;
 }
 EXPECT
+OPTION random
 parent died at (eval 2) line 1.
 child died at (eval 2) line 1.
 ########
@@ -367,6 +337,7 @@ BEGIN {
 # be overcome by treating what's after the BEGIN{} as a brand new parse.
 #print "outer\n"
 EXPECT
+OPTION random
 inner
 ########
 sub pipe_to_fork ($$) {
@@ -413,6 +384,7 @@ else {
     exit;
 }
 EXPECT
+OPTION random
 pipe_from_fork
 pipe_to_fork
 ########
@@ -434,6 +406,7 @@ else {
     exit(0);
 }
 EXPECT
+OPTION random
 forked first kid
 first child
 waitpid() returned ok
@@ -455,11 +428,13 @@ if ($pid == 0) {
     print $string_from_child eq "STRING_FROM_CHILD", "\n";
 }
 EXPECT
+OPTION random
 1
 ########
 # [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation
 sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2);
 EXPECT
+OPTION random
 1
 1
 ########
@@ -478,5 +453,6 @@ sub f {
 }
 f("foo", "bar");
 EXPECT
+OPTION random
 child: called as [main::f(foo,bar)]
 waitpid() returned ok
index 8b0429f..3e68a23 100644 (file)
@@ -9,49 +9,12 @@
 chdir 't' if -d 't';
 @INC = '../lib';
 require './test.pl';
-$Is_VMS = $^O eq 'VMS';
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
 
 $|=1;
 
-undef $/;
-@prgs = split "\n########\n", <DATA>;
-print "1..", scalar @prgs, "\n";
+run_multiple_progs('', \*DATA);
 
-$tmpfile = tempfile();
-
-for (@prgs){
-    my $switch = "";
-    if (s/^\s*(-\w+)//){
-       $switch = $1;
-    }
-    my($prog,$expected) = split(/\nEXPECT\n/, $_);
-    open TEST, ">$tmpfile";
-    print TEST "$prog\n";
-    close TEST or die "Could not close: $!";
-    my $results = $Is_VMS ?
-                      `$^X "-I[-.lib]" $switch $tmpfile 2>&1` :
-                 $Is_MSWin32 ?  
-                     `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                 $Is_NetWare ?  
-                     `perl -I../lib $switch $tmpfile 2>&1` :
-                 `./perl $switch $tmpfile 2>&1`;
-    my $status = $?;
-    $results =~ s/\n+$//;
-    # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/$::tempfile_regexp/-/ig;
-    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
-    $expected =~ s/\n+$//;
-    if ($results ne $expected) {
-       print STDERR "PROG: $switch\n$prog\n";
-       print STDERR "EXPECTED:\n$expected\n";
-       print STDERR "GOT:\n$results\n";
-       print "not ";
-    }
-    print "ok ", ++$i, "\n";
-}
+done_testing();
 
 __END__
 @a = (1, 2, 3);
index a63c39c..427e6fc 100644 (file)
 
 chdir 't' if -d 't';
 @INC = '../lib';
-$ENV{PERL5LIB} = "../lib";
+require './test.pl';
 
 $|=1;
 
-undef $/;
-@prgs = split /^########\n/m, <DATA>;
+run_multiple_progs('', \*DATA);
 
-require './test.pl';
-plan(tests => scalar @prgs);
-for (@prgs){
-    ++$i;
-    my($prog,$expected) = split(/\nEXPECT\n/, $_, 2);
-    print("not ok $i # bad test format\n"), next
-        unless defined $expected;
-    my ($testname) = $prog =~ /^# (.*)\n/m;
-    $testname ||= '';
-    $TODO = $testname =~ s/^TODO //;
-    $results =~ s/\n+$//;
-    $expected =~ s/\n+$//;
-
-    fresh_perl_is($prog, $expected, {}, $testname);
-}
+done_testing();
 
 __END__
 
index 6fc659f..4087377 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -811,7 +811,19 @@ sub fresh_perl_like {
 # what the expected output is. So have excatly one copy of the code to run that
 
 sub run_multiple_progs {
-    my @prgs = @_;
+    my $up = shift;
+    my @prgs;
+    if ($up) {
+       # The tests in lib run in a temporary subdirectory of t, and always
+       # pass in a list of "programs" to run
+       @prgs = @_;
+    } else {
+       # The tests below t run in t and pass in a file handle.
+       my $fh = shift;
+       local $/;
+       @prgs = split "\n########\n", <$fh>;
+    }
+
     my $tmpfile = tempfile();
 
     for (@prgs){
@@ -874,8 +886,10 @@ sub run_multiple_progs {
        print $fh "\n#line 1\n";  # So the line numbers don't get messed up.
        print $fh $prog,"\n";
        close $fh or die "Cannot close $tmpfile: $!";
-       my $results = runperl( switches => ["-I../../lib", $switch], nolib => 1,
-                              stderr => 1, progfile => $tmpfile );
+       my $results = runperl( stderr => 1, progfile => $tmpfile, $up
+                              ? (switches => ["-I$up/lib", $switch], nolib => 1)
+                              : (switches => [$switch])
+                               );
        my $status = $?;
        $results =~ s/\n+$//;
        # allow expected output to be written as if $prog is on STDIN