From: Andreas König Date: Sat, 29 Dec 2001 21:42:37 +0000 (+0100) Subject: cleaner close on tests, take 2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1e4d418969ad3c5103f26f33d0abea5b1570935;p=p5sagit%2Fp5-mst-13.2.git cleaner close on tests, take 2 Message-ID: (except for the three DB_File patch fragments) p4raw-id: //depot/perl@13940 --- diff --git a/ext/Devel/DProf/DProf.t b/ext/Devel/DProf/DProf.t index be711f1..5ecba68 100644 --- a/ext/Devel/DProf/DProf.t +++ b/ext/Devel/DProf/DProf.t @@ -49,7 +49,7 @@ sub profile { my $t_start = new Benchmark; open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n"; @results = ; - close R; + close R or warn "Could not close: $!"; my $t_total = timediff( new Benchmark, $t_start ); if( $opt_v ){ diff --git a/ext/PerlIO/t/encoding.t b/ext/PerlIO/t/encoding.t index e30e270..eb523ca 100644 --- a/ext/PerlIO/t/encoding.t +++ b/ext/PerlIO/t/encoding.t @@ -19,7 +19,7 @@ my $russki = "koi8r$$"; if (open(GRK, ">$grk")) { # alpha beta gamma in ISO 8859-7 print GRK "\xe1\xe2\xe3"; - close GRK; + close GRK or die "Could not close: $!"; } { @@ -30,7 +30,7 @@ if (open(GRK, ">$grk")) { print "ok 2\n"; print $o readline($i); print "ok 3\n"; - close($o); + close($o) or die "Could not close: $!"; close($i); } @@ -49,7 +49,7 @@ if (open(UTF, "<$utf")) { print "ok 6\n"; print $o readline($i); print "ok 7\n"; - close($o); + close($o) or die "Could not close: $!"; close($i); } @@ -76,7 +76,7 @@ if (!defined $warn) { if (open(RUSSKI, ">$russki")) { print RUSSKI "\x3c\x3f\x78"; - close RUSSKI; + close RUSSKI or die "Could not close: $!"; open(RUSSKI, "$russki"); binmode(RUSSKI, ":raw"); my $buf1; diff --git a/ext/SDBM_File/sdbm.t b/ext/SDBM_File/sdbm.t index e1ed259..f1a5c63 100644 --- a/ext/SDBM_File/sdbm.t +++ b/ext/SDBM_File/sdbm.t @@ -183,7 +183,7 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); 1 ; EOM - close FILE ; + close FILE or die "Could not close: $!"; BEGIN { push @INC, '.'; } diff --git a/ext/Storable/t/store.t b/ext/Storable/t/store.t index d26755f..b09b125 100644 --- a/ext/Storable/t/store.t +++ b/ext/Storable/t/store.t @@ -113,7 +113,7 @@ eval { $r = fd_retrieve(::OUT); }; print "not " unless $@; print "ok 20\n"; -close OUT; +close OUT or die "Could not close: $!"; END { 1 while unlink 'store' } diff --git a/lib/strict.t b/lib/strict.t index 3a0a2ec..f03271b 100644 --- a/lib/strict.t +++ b/lib/strict.t @@ -31,7 +31,7 @@ foreach (sort glob($^O eq 'MacOS' ? ":lib::strict:*" : "lib/strict/*")) { local $/ = undef; @prgs = (@prgs, split "\n########\n", ) ; } - close F ; + close F or die "Could not close: $!" ; } undef $/; @@ -59,7 +59,7 @@ for (@prgs){ push @temps, $filename ; open F, ">$filename" or die "Cannot open $filename: $!\n" ; print F $code ; - close F ; + close F or die "Could not close: $!" ; } shift @files ; $prog = shift @files ; @@ -67,7 +67,7 @@ for (@prgs){ } open TEST, ">$tmpfile"; print TEST $prog,"\n"; - close TEST; + close TEST or die "Could not close: $!"; my $results = $Is_MSWin32 ? `.\\perl -I../lib $switch $tmpfile 2>&1` : $^O eq 'NetWare' ? diff --git a/t/cmd/while.t b/t/cmd/while.t index ecc15ed..226db47 100755 --- a/t/cmd/while.t +++ b/t/cmd/while.t @@ -8,7 +8,7 @@ print tmp "tvi920\n"; print tmp "vt100\n"; print tmp "Amiga\n"; print tmp "paper\n"; -close tmp; +close tmp or die "Could not close: $!"; # test "last" command diff --git a/t/comp/cpp.aux b/t/comp/cpp.aux index 0589032..9452bdd 100755 --- a/t/comp/cpp.aux +++ b/t/comp/cpp.aux @@ -25,11 +25,11 @@ X#endif Xprint $ok; END print TRY $prog; -close TRY; +close TRY or die "Could not close Comp_cpp.tmp: $!"; open(TRY,">Comp_cpp.inc") || (die "Can't open temp include file: $!"); print TRY '#define OK "ok 3\n"' . "\n"; -close TRY; +close TRY or die "Could not close Comp_cpp.tmp: $!"; print `$^X "-P" Comp_cpp.tmp`; unlink "Comp_cpp.tmp", "Comp_cpp.inc"; diff --git a/t/comp/multiline.t b/t/comp/multiline.t index 742ba49..78820c4 100755 --- a/t/comp/multiline.t +++ b/t/comp/multiline.t @@ -26,7 +26,7 @@ $y = 'now is the time' . "\n" . is($x, $y, 'test data is sane'); print TRY $x; -close TRY; +close TRY or die "Could not close: $!"; open(TRY,'Comp.try') || (die "Can't reopen temp file."); $count = 0; diff --git a/t/comp/require.t b/t/comp/require.t index 103a579..ea4b96d 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -27,7 +27,7 @@ sub write_file { binmode REQ; use bytes; print REQ @_; - close REQ; + close REQ or die "Could not close $f: $!"; } eval {require 5.005}; diff --git a/t/comp/script.t b/t/comp/script.t index d70b767..2dbdaf2 100755 --- a/t/comp/script.t +++ b/t/comp/script.t @@ -16,7 +16,7 @@ if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} open(try,">Comp.script") || (die "Can't open temp file."); print try 'print "ok\n";'; print try "\n"; -close try; +close try or die "Could not close: $!"; $x = `$Perl Comp.script`; diff --git a/t/io/argv.t b/t/io/argv.t index 56b5714..a602a02 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -15,7 +15,7 @@ my $devnull = File::Spec->devnull; open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); print TRY "a line\n"; -close TRY; +close TRY or die "Could not close: $!"; $x = runperl( prog => 'while (<>) { print $., $_; }', @@ -50,9 +50,9 @@ is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV'); open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!"; -close TRY; +close TRY or die "Could not close: $!"; open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!"; -close TRY; +close TRY or die "Could not close: $!"; @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp'); $^I = '_bak'; # not .bak which confuses VMS $/ = undef; @@ -67,7 +67,7 @@ open(TRY, '; open(TRY, '; -close TRY; +close TRY or die "Could not close: $!"; undef $^I; ok( eof TRY ); @@ -95,7 +95,7 @@ ok( eof(), 'eof() true after closing ARGV' ); { local $/; - open F, 'Io_argv1.tmp' or die; + open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!"; ; # set $. = 1 is( , undef ); @@ -108,7 +108,7 @@ ok( eof(), 'eof() true after closing ARGV' ); open F, $devnull or die; # restart cycle again ok( defined() ); is( , undef ); - close F; + close F or die "Could not close: $!"; } END { unlink 'Io_argv1.tmp', 'Io_argv1.tmp_bak', 'Io_argv2.tmp', 'Io_argv2.tmp_bak' } diff --git a/t/io/dup.t b/t/io/dup.t index 96fe3be..6555d07 100755 --- a/t/io/dup.t +++ b/t/io/dup.t @@ -40,11 +40,11 @@ else { system sprintf "$echo 1>&2", 7; } -close(STDOUT); -close(STDERR); +close(STDOUT) or die "Could not close: $!"; +close(STDERR) or die "Could not close: $!"; -open(STDOUT,">&DUPOUT"); -open(STDERR,">&DUPERR"); +open(STDOUT,">&DUPOUT") or die "Could not open: $!"; +open(STDERR,">&DUPERR") or die "Could not open: $!"; if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` } else { system 'cat Io.dup' } diff --git a/t/lib/filter-util.pl b/t/lib/filter-util.pl index 826d853..c378f22 100644 --- a/t/lib/filter-util.pl +++ b/t/lib/filter-util.pl @@ -25,7 +25,7 @@ sub writeFile binmode(F) if $filename =~ /bin$/i; foreach (@strings) { print F } - close F ; + close F or die "Could not close: $!" ; } sub ok diff --git a/t/op/anonsub.t b/t/op/anonsub.t index fef40f9..8eca75b 100755 --- a/t/op/anonsub.t +++ b/t/op/anonsub.t @@ -26,7 +26,7 @@ for (@prgs){ my($prog,$expected) = split(/\nEXPECT\n/, $_); open TEST, ">$tmpfile"; print TEST "$prog\n"; - close TEST; + close TEST or die "Could not close: $!"; my $results = $Is_VMS ? `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` : $Is_MSWin32 ? diff --git a/t/op/do.t b/t/op/do.t index 913481f..744a62b 100755 --- a/t/op/do.t +++ b/t/op/do.t @@ -61,31 +61,31 @@ unshift @INC, '.'; if (open(DO, ">$$.16")) { print DO "ok(1, 'do in scalar context') if defined wantarray && not wantarray\n"; - close DO; + close DO or die "Could not close: $!"; } my $a = do "$$.16"; if (open(DO, ">$$.17")) { print DO "ok(1, 'do in list context') if defined wantarray && wantarray\n"; - close DO; + close DO or die "Could not close: $!"; } my @a = do "$$.17"; if (open(DO, ">$$.18")) { print DO "ok(1, 'do in void context') if not defined wantarray\n"; - close DO; + close DO or die "Could not close: $!"; } do "$$.18"; # bug ID 20010920.007 eval qq{ do qq(a file that does not exist); }; -ok( !$@ ); +ok( !$@, "do on a non-existing file, first try" ); eval qq{ do uc qq(a file that does not exist); }; -ok( !$@ ); +ok( !$@, "do on a non-existing file, second try" ); END { 1 while unlink("$$.16", "$$.17", "$$.18"); diff --git a/t/op/inccode.t b/t/op/inccode.t index bd66628..49ab85f 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -20,7 +20,7 @@ sub get_temp_fh { push @tempfiles, $f; open my $fh, ">$f" or die "Can't create $f: $!"; print $fh "package ".substr($_[0],0,-3)."; 1;"; - close $fh; + close $fh or die "Couldn't close: $!"; open $fh, $f or die "Can't open $f: $!"; return $fh; } @@ -39,22 +39,29 @@ sub fooinc { push @INC, \&fooinc; -ok( !eval { require Bar; 1 }, 'Trying non-magic package' ); - -ok( eval { require Foo; 1 }, 'require() magic via code ref' ); -ok( exists $INC{'Foo.pm'}, ' %INC sees it' ); -is( ref $INC{'Foo.pm'}, 'CODE', ' key is a coderef in %INC' ); -is( $INC{'Foo.pm'}, \&fooinc, ' key is correct in %INC' ); - -ok( eval "use Foo1; 1;", 'use()' ); -ok( exists $INC{'Foo1.pm'}, ' %INC sees it' ); -is( ref $INC{'Foo1.pm'}, 'CODE', ' key is a coderef in %INC' ); -is( $INC{'Foo1.pm'}, \&fooinc, ' key is correct in %INC' ); - -ok( eval { do 'Foo2.pl'; 1 }, 'do()' ); -ok( exists $INC{'Foo2.pl'}, ' %INC sees it' ); -is( ref $INC{'Foo2.pl'}, 'CODE', ' key is a coderef in %INC' ); -is( $INC{'Foo2.pl'}, \&fooinc, ' key is correct in %INC' ); +my $evalret = eval { require Bar; 1 }; +ok( !$evalret, 'Trying non-magic package' ); + +$evalret = eval { require Foo; 1 }; +die $@ if $@; +ok( $evalret, 'require Foo; magic via code ref' ); +ok( exists $INC{'Foo.pm'}, ' %INC sees Foo.pm' ); +is( ref $INC{'Foo.pm'}, 'CODE', ' val Foo.pm is a coderef in %INC' ); +is( $INC{'Foo.pm'}, \&fooinc, ' val Foo.pm is correct in %INC' ); + +$evalret = eval "use Foo1; 1;"; +die $@ if $@; +ok( $evalret, 'use Foo1' ); +ok( exists $INC{'Foo1.pm'}, ' %INC sees Foo1.pm' ); +is( ref $INC{'Foo1.pm'}, 'CODE', ' val Foo1.pm is a coderef in %INC' ); +is( $INC{'Foo1.pm'}, \&fooinc, ' val Foo1.pm is correct in %INC' ); + +$evalret = eval { do 'Foo2.pl'; 1 }; +die $@ if $@; +ok( $evalret, 'do "Foo2.pl"' ); +ok( exists $INC{'Foo2.pl'}, ' %INC sees Foo2.pl' ); +is( ref $INC{'Foo2.pl'}, 'CODE', ' val Foo2.pl is a coderef in %INC' ); +is( $INC{'Foo2.pl'}, \&fooinc, ' val Foo2.pl is correct in %INC' ); pop @INC; @@ -72,23 +79,28 @@ sub fooinc2 { my $arrayref = [ \&fooinc2, 'Bar' ]; push @INC, $arrayref; -ok( eval { require Foo; 1; }, 'Originally loaded packages preserved' ); -ok( !eval { require Foo3; 1; }, 'Original magic INC purged' ); - -ok( eval { require Bar; 1 }, 'require() magic via array ref' ); -ok( exists $INC{'Bar.pm'}, ' %INC sees it' ); -is( ref $INC{'Bar.pm'}, 'ARRAY', ' key is an arrayref in %INC' ); -is( $INC{'Bar.pm'}, $arrayref, ' key is correct in %INC' ); - -ok( eval "use Bar1; 1;", 'use()' ); -ok( exists $INC{'Bar1.pm'}, ' %INC sees it' ); -is( ref $INC{'Bar1.pm'}, 'ARRAY', ' key is an arrayref in %INC' ); -is( $INC{'Bar1.pm'}, $arrayref, ' key is correct in %INC' ); - -ok( eval { do 'Bar2.pl'; 1 }, 'do()' ); -ok( exists $INC{'Bar2.pl'}, ' %INC sees it' ); -is( ref $INC{'Bar2.pl'}, 'ARRAY', ' key is an arrayref in %INC' ); -is( $INC{'Bar2.pl'}, $arrayref, ' key is correct in %INC' ); +$evalret = eval { require Foo; 1; }; +die $@ if $@; +ok( $evalret, 'Originally loaded packages preserved' ); +$evalret = eval { require Foo3; 1; }; +ok( !$evalret, 'Original magic INC purged' ); + +$evalret = eval { require Bar; 1 }; +die $@ if $@; +ok( $evalret, 'require Bar; magic via array ref' ); +ok( exists $INC{'Bar.pm'}, ' %INC sees Bar.pm' ); +is( ref $INC{'Bar.pm'}, 'ARRAY', ' val Bar.pm is an arrayref in %INC' ); +is( $INC{'Bar.pm'}, $arrayref, ' val Bar.pm is correct in %INC' ); + +ok( eval "use Bar1; 1;", 'use Bar1' ); +ok( exists $INC{'Bar1.pm'}, ' %INC sees Bar1.pm' ); +is( ref $INC{'Bar1.pm'}, 'ARRAY', ' val Bar1.pm is an arrayref in %INC' ); +is( $INC{'Bar1.pm'}, $arrayref, ' val Bar1.pm is correct in %INC' ); + +ok( eval { do 'Bar2.pl'; 1 }, 'do "Bar2.pl"' ); +ok( exists $INC{'Bar2.pl'}, ' %INC sees Bar2.pl' ); +is( ref $INC{'Bar2.pl'}, 'ARRAY', ' val Bar2.pl is an arrayref in %INC' ); +is( $INC{'Bar2.pl'}, $arrayref, ' val Bar2.pl is correct in %INC' ); pop @INC; @@ -105,33 +117,39 @@ sub FooLoader::INC { my $href = bless( {}, 'FooLoader' ); push @INC, $href; -ok( eval { require Quux; 1 }, 'require() magic via hash object' ); -ok( exists $INC{'Quux.pm'}, ' %INC sees it' ); +$evalret = eval { require Quux; 1 }; +die $@ if $@; +ok( $evalret, 'require Quux; magic via hash object' ); +ok( exists $INC{'Quux.pm'}, ' %INC sees Quux.pm' ); is( ref $INC{'Quux.pm'}, 'FooLoader', - ' key is an object in %INC' ); -is( $INC{'Quux.pm'}, $href, ' key is correct in %INC' ); + ' val Quux.pm is an object in %INC' ); +is( $INC{'Quux.pm'}, $href, ' val Quux.pm is correct in %INC' ); pop @INC; my $aref = bless( [], 'FooLoader' ); push @INC, $aref; -ok( eval { require Quux1; 1 }, 'require() magic via array object' ); -ok( exists $INC{'Quux1.pm'}, ' %INC sees it' ); +$evalret = eval { require Quux1; 1 }; +die $@ if $@; +ok( $evalret, 'require Quux1; magic via array object' ); +ok( exists $INC{'Quux1.pm'}, ' %INC sees Quux1.pm' ); is( ref $INC{'Quux1.pm'}, 'FooLoader', - ' key is an object in %INC' ); -is( $INC{'Quux1.pm'}, $aref, ' key is correct in %INC' ); + ' val Quux1.pm is an object in %INC' ); +is( $INC{'Quux1.pm'}, $aref, ' val Quux1.pm is correct in %INC' ); pop @INC; my $sref = bless( \(my $x = 1), 'FooLoader' ); push @INC, $sref; -ok( eval { require Quux2; 1 }, 'require() magic via scalar object' ); -ok( exists $INC{'Quux2.pm'}, ' %INC sees it' ); +$evalret = eval { require Quux2; 1 }; +die $@ if $@; +ok( $evalret, 'require Quux2; magic via scalar object' ); +ok( exists $INC{'Quux2.pm'}, ' %INC sees Quux2.pm' ); is( ref $INC{'Quux2.pm'}, 'FooLoader', - ' key is an object in %INC' ); -is( $INC{'Quux2.pm'}, $sref, ' key is correct in %INC' ); + ' val Quux2.pm is an object in %INC' ); +is( $INC{'Quux2.pm'}, $sref, ' val Quux2.pm is correct in %INC' ); pop @INC; @@ -146,9 +164,11 @@ push @INC, sub { } }; -ok( eval { require Toto; 1 }, 'require() magic via anonymous code ref' ); -ok( exists $INC{'Toto.pm'}, ' %INC sees it' ); -ok( ! ref $INC{'Toto.pm'}, q/ key isn't a ref in %INC/ ); -is( $INC{'Toto.pm'}, 'xyz', ' key is correct in %INC' ); +$evalret = eval { require Toto; 1 }; +die $@ if $@; +ok( $evalret, 'require Toto; magic via anonymous code ref' ); +ok( exists $INC{'Toto.pm'}, ' %INC sees Toto.pm' ); +ok( ! ref $INC{'Toto.pm'}, q/ val Toto.pm isn't a ref in %INC/ ); +is( $INC{'Toto.pm'}, 'xyz', ' val Toto.pm is correct in %INC' ); pop @INC; diff --git a/t/op/runlevel.t b/t/op/runlevel.t index 03e253e..6a10e8b 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -31,7 +31,7 @@ for (@prgs){ my($prog,$expected) = split(/\nEXPECT\n/, $_); open TEST, ">$tmpfile"; print TEST "$prog\n"; - close TEST; + close TEST or die "Could not close: $!"; my $results = $Is_VMS ? `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` : $Is_MSWin32 ? diff --git a/t/op/write.t b/t/op/write.t index fdc6e56..2475996 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -36,7 +36,7 @@ $good = 'good'; $multiline = "forescore\nand\nseven years\n"; $foo = 'when in the course of human events it becomes necessary'; write(OUT); -close OUT; +close OUT or die "Could not close: $!"; $right = "the quick brown fox @@ -75,7 +75,7 @@ $good = 'good'; $multiline = "forescore\nand\nseven years\n"; $foo = 'when in the course of human events it becomes necessary'; write(OUT2); -close OUT2; +close OUT2 or die "Could not close: $!"; $right = "the quick brown fox @@ -118,7 +118,7 @@ $good = 'good'; $multiline = "forescore\nand\nseven years\n"; $foo = 'when in the course of human events it becomes necessary'; write(OUT2); -close OUT2; +close OUT2 or die "Could not close: $!"; $right = "the brown quick fox @@ -185,7 +185,7 @@ open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp"; $foo = 'fit '; write(OUT3); -close OUT3; +close OUT3 or die "Could not close: $!"; $right = "fit\n"; @@ -207,7 +207,7 @@ $this,$that write LEX; $that = 8; write LEX; - close LEX; + close LEX or die "Could not close: $!"; } # LEX_INTERPNORMAL test my %e = ( a => 1 ); @@ -217,7 +217,7 @@ format OUT4 = . open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp"; write (OUT4); -close OUT4; +close OUT4 or die "Could not close: $!"; if (`$CAT Op_write.tmp` eq "1\n") { print "ok 9\n"; 1 while unlink "Op_write.tmp"; @@ -237,7 +237,7 @@ open(OUT10, '>Op_write.tmp') || die "Can't create Op_write.tmp"; $test1 = 12.95; write(OUT10); -close OUT10; +close OUT10 or die "Could not close: $!"; $right = " 12.95 00012.95\n"; if (`$CAT Op_write.tmp` eq $right) @@ -260,7 +260,7 @@ open(OUT11, '>Op_write.tmp') || die "Can't create Op_write.tmp"; $test1 = 12.95; write(OUT11); -close OUT11; +close OUT11 or die "Could not close: $!"; $right = "00012.95 diff --git a/t/run/switches.t b/t/run/switches.t index 67331b6..f920f37 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -77,7 +77,7 @@ INIT { print "block 3\n"; } print "block 4\n"; END { print "block 5\n"; } SWTEST - close $f; + close $f or die "Could not close: $!"; $r = runperl( switches => [ '-c' ], progfile => $filename, @@ -122,7 +122,7 @@ SKIP: { #!perl -s print $x SWTEST - close $f; + close $f or die "Could not close: $!"; $r = runperl( switches => [ '-s' ], progfile => $filename, @@ -142,7 +142,7 @@ package swtest; sub import { print map "<$_>", @_ } 1; SWTESTPM - close $f; + close $f or die "Could not close: $!"; $r = runperl( switches => [ '-Mswtest' ], prog => '1',