develooper Front page | perl.perl5.porters | Postings from December 2001

[PATCH] cleaner close on tests, take 2

Thread Next
From:
andreas.koenig
Date:
December 29, 2001 12:45
Subject:
[PATCH] cleaner close on tests, take 2
Message ID:
m33d1tvjuq.fsf@anima.de
As long as we do not have the fatal pragma I thought I could optimized
a couple of tests for the case of a full disk anyway. I believe that
we should die whenever close() fails. Continuing after such a
fundamental problem would only obscure the test result. I also believe
that the same is true for tie(). Paul?

The first three patches are for DB_File test and should only be
applied if Paul agrees.

18 of the other 19 are very simple and straightforward.

Only the patch for t/op/inccode.t is a bit more involved. It
diversifies the error messages to enable the reader to identify the
exact location of a failing test AND throws in a few die() to reduce
the noise of failing tests.

All tests still pass if the disk is not full ;)



# Optimize perl tests for the case of a full disk
# 
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####

#### Patch data follows ####
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/DB_File/t/db-btree.t' 'perl-5.7.2@13919/ext/DB_File/t/db-btree.t'
Index: ./ext/DB_File/t/db-btree.t
--- ./ext/DB_File/t/db-btree.t	Fri Dec 28 19:55:28 2001
+++ ./ext/DB_File/t/db-btree.t	Sat Dec 29 10:45:40 2001
@@ -156,6 +156,7 @@
 
 my ($X, %h) ;
 ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
+die "Could not tie: $!" unless $X;
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
@@ -525,9 +526,9 @@
  
  
 my (%g, %k);
-tie(%h, 'DB_File',$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) ; 
-tie(%g, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) ;
-tie(%k, 'DB_File',$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) ;
+tie(%h, 'DB_File',$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) or die $!;
+tie(%g, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) or die $!;
+tie(%k, 'DB_File',$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) or die $!;
  
 my @Keys = qw( 0123 12 -1234 9 987654321 def  ) ;
 my (@srt_1, @srt_2, @srt_3);
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/DB_File/t/db-hash.t' 'perl-5.7.2@13919/ext/DB_File/t/db-hash.t'
Index: ./ext/DB_File/t/db-hash.t
--- ./ext/DB_File/t/db-hash.t	Fri Dec 28 19:55:28 2001
+++ ./ext/DB_File/t/db-hash.t	Sat Dec 29 11:04:11 2001
@@ -125,6 +125,7 @@
 # Now check the interface to HASH
 my ($X, %h);
 ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+die "Could not tie: $!" unless $X;
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/DB_File/t/db-recno.t' 'perl-5.7.2@13919/ext/DB_File/t/db-recno.t'
Index: ./ext/DB_File/t/db-recno.t
--- ./ext/DB_File/t/db-recno.t	Fri Dec 28 19:55:28 2001
+++ ./ext/DB_File/t/db-recno.t	Sat Dec 29 11:09:23 2001
@@ -444,7 +444,7 @@
    1 ;
 EOM
 
-    close FILE ;
+    close FILE  or die "Could not close: $!";
 
     BEGIN { push @INC, '.'; } 
     eval 'use SubDB ; ';
@@ -454,6 +454,7 @@
     eval '
 	$X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
 	' ;
+    die "Could not tie: $!" unless $X;
 
     main::ok(68, $@ eq "") ;
 
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/Devel/DProf/DProf.t' 'perl-5.7.2@13919/ext/Devel/DProf/DProf.t'
Index: ./ext/Devel/DProf/DProf.t
--- ./ext/Devel/DProf/DProf.t	Fri Dec 28 19:55:22 2001
+++ ./ext/Devel/DProf/DProf.t	Sat Dec 29 11:16:56 2001
@@ -49,7 +49,7 @@
 	my $t_start = new Benchmark;
         open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n";
 	@results = <R>;
-	close R;
+	close R or warn "Could not close: $!";
 	my $t_total = timediff( new Benchmark, $t_start );
 
 	if( $opt_v ){
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/PerlIO/t/encoding.t' 'perl-5.7.2@13919/ext/PerlIO/t/encoding.t'
Index: ./ext/PerlIO/t/encoding.t
--- ./ext/PerlIO/t/encoding.t	Fri Dec 28 19:55:23 2001
+++ ./ext/PerlIO/t/encoding.t	Sat Dec 29 11:57:26 2001
@@ -19,7 +19,7 @@
 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 @@
     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 @@
     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 (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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/SDBM_File/sdbm.t' 'perl-5.7.2@13919/ext/SDBM_File/sdbm.t'
Index: ./ext/SDBM_File/sdbm.t
--- ./ext/SDBM_File/sdbm.t	Fri Dec 28 19:55:13 2001
+++ ./ext/SDBM_File/sdbm.t	Sat Dec 29 10:58:36 2001
@@ -183,7 +183,7 @@
    1 ;
 EOM
 
-    close FILE ;
+    close FILE  or die "Could not close: $!";
 
     BEGIN { push @INC, '.'; }
 
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/ext/Storable/t/store.t' 'perl-5.7.2@13919/ext/Storable/t/store.t'
Index: ./ext/Storable/t/store.t
Prereq:  1.0 
--- ./ext/Storable/t/store.t	Mon Jul  9 16:10:13 2001
+++ ./ext/Storable/t/store.t	Sat Dec 29 11:30:18 2001
@@ -113,7 +113,7 @@
 print "not " unless $@;
 print "ok 20\n";
 
-close OUT;
+close OUT or die "Could not close: $!";
 END { 1 while unlink 'store' }
 
 
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/lib/strict.t' 'perl-5.7.2@13919/lib/strict.t'
Index: ./lib/strict.t
--- ./lib/strict.t	Fri Dec 28 19:55:05 2001
+++ ./lib/strict.t	Sat Dec 29 11:26:00 2001
@@ -31,7 +31,7 @@
         local $/ = undef;
         @prgs = (@prgs, split "\n########\n", <F>) ;
     }
-    close F ;
+    close F or die "Could not close: $!" ;
 }
 
 undef $/;
@@ -59,7 +59,7 @@
     	    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 @@
     }
     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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/cmd/while.t' 'perl-5.7.2@13919/t/cmd/while.t'
Index: ./t/cmd/while.t
--- ./t/cmd/while.t	Mon Jul  9 16:11:21 2001
+++ ./t/cmd/while.t	Sat Dec 29 08:59:35 2001
@@ -8,7 +8,7 @@
 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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/comp/cpp.aux' 'perl-5.7.2@13919/t/comp/cpp.aux'
Index: ./t/comp/cpp.aux
--- ./t/comp/cpp.aux	Fri Dec 28 19:55:32 2001
+++ ./t/comp/cpp.aux	Sat Dec 29 08:39:16 2001
@@ -25,11 +25,11 @@
 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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/comp/multiline.t' 'perl-5.7.2@13919/t/comp/multiline.t'
Index: ./t/comp/multiline.t
--- ./t/comp/multiline.t	Fri Dec 28 19:55:37 2001
+++ ./t/comp/multiline.t	Sat Dec 29 08:40:56 2001
@@ -26,7 +26,7 @@
 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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/comp/require.t' 'perl-5.7.2@13919/t/comp/require.t'
Index: ./t/comp/require.t
--- ./t/comp/require.t	Fri Dec 28 19:54:50 2001
+++ ./t/comp/require.t	Sat Dec 29 08:42:55 2001
@@ -27,7 +27,7 @@
     binmode REQ;
     use bytes;
     print REQ @_;
-    close REQ;
+    close REQ or die "Could not close $f: $!";
 }
 
 eval {require 5.005};
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/comp/script.t' 'perl-5.7.2@13919/t/comp/script.t'
Index: ./t/comp/script.t
--- ./t/comp/script.t	Fri Dec 28 19:55:35 2001
+++ ./t/comp/script.t	Sat Dec 29 08:49:26 2001
@@ -16,7 +16,7 @@
 
 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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/io/argv.t' 'perl-5.7.2@13919/t/io/argv.t'
Index: ./t/io/argv.t
--- ./t/io/argv.t	Fri Dec 28 19:55:22 2001
+++ ./t/io/argv.t	Sat Dec 29 08:57:44 2001
@@ -15,7 +15,7 @@
 
 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 @@
 
 
 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 @@
 print while <TRY>;
 open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
 print while <TRY>;
-close TRY;
+close TRY or die "Could not close: $!";
 undef $^I;
 
 ok( eof TRY );
@@ -95,7 +95,7 @@
 
 {
     local $/;
-    open F, 'Io_argv1.tmp' or die;
+    open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
     <F>;	# set $. = 1
     is( <F>, undef );
 
@@ -108,7 +108,7 @@
     open F, $devnull or die;	# restart cycle again
     ok( defined(<F>) );
     is( <F>, 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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/io/dup.t' 'perl-5.7.2@13919/t/io/dup.t'
Index: ./t/io/dup.t
--- ./t/io/dup.t	Fri Dec 28 19:55:37 2001
+++ ./t/io/dup.t	Sat Dec 29 09:54:31 2001
@@ -40,11 +40,11 @@
     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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/lib/filter-util.pl' 'perl-5.7.2@13919/t/lib/filter-util.pl'
Index: ./t/lib/filter-util.pl
--- ./t/lib/filter-util.pl	Fri Dec 28 19:55:25 2001
+++ ./t/lib/filter-util.pl	Sat Dec 29 11:13:36 2001
@@ -25,7 +25,7 @@
     binmode(F) if $filename =~ /bin$/i;
     foreach (@strings)
       { print F }
-    close F ;
+    close F or die "Could not close: $!" ;
 }
 
 sub ok
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/op/anonsub.t' 'perl-5.7.2@13919/t/op/anonsub.t'
Index: ./t/op/anonsub.t
--- ./t/op/anonsub.t	Fri Dec 28 19:55:05 2001
+++ ./t/op/anonsub.t	Sat Dec 29 10:01:54 2001
@@ -26,7 +26,7 @@
     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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/op/do.t' 'perl-5.7.2@13919/t/op/do.t'
Index: ./t/op/do.t
--- ./t/op/do.t	Fri Dec 28 19:55:03 2001
+++ ./t/op/do.t	Sat Dec 29 09:35:10 2001
@@ -61,31 +61,31 @@
 
 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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/op/inccode.t' 'perl-5.7.2@13919/t/op/inccode.t'
Index: ./t/op/inccode.t
--- ./t/op/inccode.t	Fri Dec 28 19:55:06 2001
+++ ./t/op/inccode.t	Sat Dec 29 21:31:42 2001
@@ -20,7 +20,7 @@
     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 @@
 
 push @INC, \&fooinc;
 
-ok( !eval { require Bar; 1 },      'Trying non-magic package' );
+my $evalret = eval { require Bar; 1 };
+ok( !$evalret,      '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' );
+$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 @@
 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 @@
 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 @@
     }
 };
 
-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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/op/runlevel.t' 'perl-5.7.2@13919/t/op/runlevel.t'
Index: ./t/op/runlevel.t
--- ./t/op/runlevel.t	Fri Dec 28 19:55:05 2001
+++ ./t/op/runlevel.t	Sat Dec 29 11:59:05 2001
@@ -31,7 +31,7 @@
     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 -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/op/write.t' 'perl-5.7.2@13919/t/op/write.t'
Index: ./t/op/write.t
--- ./t/op/write.t	Fri Dec 28 19:55:37 2001
+++ ./t/op/write.t	Sat Dec 29 10:43:19 2001
@@ -36,7 +36,7 @@
 $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 @@
 $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 @@
 $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 @@
 
 $foo = 'fit          ';
 write(OUT3);
-close OUT3;
+close OUT3 or die "Could not close: $!";
 
 $right =
 "fit\n";
@@ -207,7 +207,7 @@
     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 @@
 .
 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 @@
 
 $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 @@
 
 $test1 = 12.95;
 write(OUT11);
-close OUT11;
+close OUT11 or die "Could not close: $!";
 
 $right = 
 "00012.95
diff -u '/usr/sources/perl/repoperls/perl-5.7.2@13919/t/run/switches.t' 'perl-5.7.2@13919/t/run/switches.t'
Index: ./t/run/switches.t
--- ./t/run/switches.t	Fri Dec 28 19:55:35 2001
+++ ./t/run/switches.t	Sat Dec 29 08:48:39 2001
@@ -77,7 +77,7 @@
 	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 @@
 #!perl -s
 print $x
 SWTEST
-    close $f;
+    close $f or die "Could not close: $!";
     $r = runperl(
 	switches    => [ '-s' ],
 	progfile    => $filename,
@@ -142,7 +142,7 @@
 sub import { print map "<$_>", @_ }
 1;
 SWTESTPM
-    close $f;
+    close $f or die "Could not close: $!";
     $r = runperl(
 	switches    => [ '-Mswtest' ],
 	prog	    => '1',
#### End of Patch data ####

#### ApplyPatch data follows ####
# Data version        : 1.0
# Date generated      : Sat Dec 29 21:33:01 2001
# Generated by        : makepatch 2.00_07*
# Recurse directories : Yes
# Excluded files      : (\A|/).*\~\Z
#                       (\A|/).*\.a\Z
#                       (\A|/).*\.bak\Z
#                       (\A|/).*\.BAK\Z
#                       (\A|/).*\.elc\Z
#                       (\A|/).*\.exe\Z
#                       (\A|/).*\.gz\Z
#                       (\A|/).*\.ln\Z
#                       (\A|/).*\.o\Z
#                       (\A|/).*\.obj\Z
#                       (\A|/).*\.olb\Z
#                       (\A|/).*\.old\Z
#                       (\A|/).*\.orig\Z
#                       (\A|/).*\.rej\Z
#                       (\A|/).*\.so\Z
#                       (\A|/).*\.Z\Z
#                       (\A|/)\.del\-.*\Z
#                       (\A|/)\.make\.state\Z
#                       (\A|/)\.nse_depinfo\Z
#                       (\A|/)core\Z
#                       (\A|/)tags\Z
#                       (\A|/)TAGS\Z
# v 'patchlevel.h' 4254 1009565744 33188
# p 'ext/DB_File/t/db-btree.t' 29758 1009619140 0100644
# p 'ext/DB_File/t/db-hash.t' 18189 1009620251 0100644
# p 'ext/DB_File/t/db-recno.t' 29648 1009620563 0100644
# p 'ext/Devel/DProf/DProf.t' 1737 1009621016 0100644
# p 'ext/PerlIO/t/encoding.t' 2090 1009623446 0100644
# p 'ext/SDBM_File/sdbm.t' 11819 1009619916 0100644
# p 'ext/Storable/t/store.t' 2471 1009621818 0100644
# p 'lib/strict.t' 2671 1009621560 0100644
# p 't/cmd/while.t' 3498 1009612775 0100644
# p 't/comp/cpp.aux' 670 1009611556 0100644
# p 't/comp/multiline.t' 900 1009611656 0100644
# p 't/comp/require.t' 3353 1009611775 0100644
# p 't/comp/script.t' 567 1009612166 0100755
# p 't/io/argv.t' 2289 1009612664 0100644
# p 't/io/dup.t' 1073 1009616071 0100644
# p 't/lib/filter-util.pl' 923 1009620816 0100644
# p 't/op/anonsub.t' 2049 1009616514 0100644
# p 't/op/do.t' 1672 1009614910 0100755
# p 't/op/inccode.t' 4299 1009657902 0100644
# p 't/op/runlevel.t' 6112 1009623545 0100644
# p 't/op/write.t' 7064 1009618999 0100644
# p 't/run/switches.t' 3829 1009612119 0100644
#### End of ApplyPatch data ####

#### End of Patch kit [created: Sat Dec 29 21:33:01 2001] ####
#### Patch checksum: 726 24533 26797 ####
#### Checksum: 744 25206 17271 ####


-- 
andreas

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About