do $file; won't propagate errors from die, as do is an implicit eval.

So need to propagate errors with $@.

p4raw-id: //depot/perl@29723

27 files changed, 44 insertions, 44 deletions

diff --git a/ext/DynaLoader/hints/gnukfreebsd.pl b/ext/DynaLoader/hints/gnukfreebsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/DynaLoader/hints/gnukfreebsd.pl
+++ b/ext/DynaLoader/hints/gnukfreebsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/DynaLoader/hints/gnuknetbsd.pl b/ext/DynaLoader/hints/gnuknetbsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/DynaLoader/hints/gnuknetbsd.pl
+++ b/ext/DynaLoader/hints/gnuknetbsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/NDBM_File/hints/gnukfreebsd.pl b/ext/NDBM_File/hints/gnukfreebsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/NDBM_File/hints/gnukfreebsd.pl
+++ b/ext/NDBM_File/hints/gnukfreebsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/NDBM_File/hints/gnuknetbsd.pl b/ext/NDBM_File/hints/gnuknetbsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/NDBM_File/hints/gnuknetbsd.pl
+++ b/ext/NDBM_File/hints/gnuknetbsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/ODBM_File/hints/gnukfreebsd.pl b/ext/ODBM_File/hints/gnukfreebsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/ODBM_File/hints/gnukfreebsd.pl
+++ b/ext/ODBM_File/hints/gnukfreebsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/ODBM_File/hints/gnuknetbsd.pl b/ext/ODBM_File/hints/gnuknetbsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/ODBM_File/hints/gnuknetbsd.pl
+++ b/ext/ODBM_File/hints/gnuknetbsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/POSIX/hints/gnukfreebsd.pl b/ext/POSIX/hints/gnukfreebsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/POSIX/hints/gnukfreebsd.pl
+++ b/ext/POSIX/hints/gnukfreebsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/POSIX/hints/gnuknetbsd.pl b/ext/POSIX/hints/gnuknetbsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/POSIX/hints/gnuknetbsd.pl
+++ b/ext/POSIX/hints/gnuknetbsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/Storable/hints/gnukfreebsd.pl b/ext/Storable/hints/gnukfreebsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/Storable/hints/gnukfreebsd.pl
+++ b/ext/Storable/hints/gnukfreebsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/ext/Storable/hints/gnuknetbsd.pl b/ext/Storable/hints/gnuknetbsd.pl
index 6e37b40270..db63567966 100644
--- a/ext/Storable/hints/gnuknetbsd.pl
+++ b/ext/Storable/hints/gnuknetbsd.pl
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e031ac2495..1b9f376a66 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2407,7 +2407,7 @@ Uses C<dumpvar.pl> to dump out the current values for selected variables.
                     @vars     = split( ' ', $2 );
 
                     # If main::dumpvar isn't here, get it.
-                    do 'dumpvar.pl' unless defined &main::dumpvar;
+                    do 'dumpvar.pl' || die $@ unless defined &main::dumpvar;
                     if ( defined &main::dumpvar ) {
 
                         # We got it. Turn off subroutine entry/exit messages
@@ -2606,7 +2606,7 @@ above the current one and then displays then using C<dumpvar.pl>.
                       and next CMD;
 
                     # Load up dumpvar if we don't have it. If we can, that is.
-                    do 'dumpvar.pl' unless defined &main::dumpvar;
+                    do 'dumpvar.pl' || die $@ unless defined &main::dumpvar;
                     defined &main::dumpvar
                       or print $OUT "dumpvar.pl not available.\n"
                       and next CMD;
@@ -5584,7 +5584,7 @@ sub dumpit {
 
     # Load dumpvar.pl unless we've already got the sub we need from it.
     unless ( defined &main::dumpValue ) {
-        do 'dumpvar.pl';
+        do 'dumpvar.pl' or die $@;
     }
 
     # If the load succeeded (or we already had dumpvalue()), go ahead
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index de4d01d95c..8a2ba71066 100644
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -194,7 +194,7 @@ sub SWASHNEW {
 		return $Cache{$class, $file};
 	    }
 
-	    $list = do $file;
+	    $list = do $file; die $@ if $@;
 	}
 
         $ListSorted = 1; ## we know that these lists are sorted
diff --git a/symbian/config.pl b/symbian/config.pl
index 52b6e71a67..f35efb62e8 100644
--- a/symbian/config.pl
+++ b/symbian/config.pl
@@ -9,9 +9,9 @@ use lib "symbian";
 print "Configuring...\n";
 print "Configuring with: Perl version $] ($^X)\n";
 
-do "sanity.pl";
+do "sanity.pl" or die $@;
 
-my %VERSION = %{ do "version.pl" };
+my %VERSION = %{ do "version.pl" or die $@ };
 
 printf "Configuring for:  Perl version $VERSION{REVISION}.%03d%03d\n",
   $VERSION{VERSION}, $VERSION{SUBVERSION};
@@ -20,8 +20,8 @@ my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
 my $R_V_SV  = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
 
 my ($SYMBIAN_ROOT, $SYMBIAN_VERSION, $SDK_NAME, $SDK_VARIANT, $SDK_VERSION) =
-    @{ do "sdk.pl" };
-my %PORT = %{ do "port.pl" };
+    @{ do "sdk.pl" or die $@ };
+my %PORT = %{ do "port.pl" or die $@ };
 
 if ($SYMBIAN_ROOT eq 'C:\Symbian\Series60_1_2_CW') {
     ( $SYMBIAN_VERSION, $SDK_VERSION ) = qw(6.1 1.2);
@@ -48,7 +48,7 @@ die "$0: does not know which Windows compiler to use\n"
 
 print "Symbian $SYMBIAN_VERSION SDK $SDK_VARIANT $SDK_VERSION ($WIN) installed at $SYMBIAN_ROOT\n";
 
-my $CWD = do "cwd.pl";
+my $CWD = do "cwd.pl" or die $@;
 print "Build directory $CWD\n";
 
 die "$0: '+' in cwd does not work with Series 60 SDK 1.2\n"
diff --git a/symbian/makesis.pl b/symbian/makesis.pl
index dbf533ce7b..377a7c72be 100644
--- a/symbian/makesis.pl
+++ b/symbian/makesis.pl
@@ -5,16 +5,16 @@
 use strict;
 use lib "symbian";
 
-do "sanity.pl";
+do "sanity.pl" or die $@;
 
-my %VERSION = %{ do "version.pl" };
+my %VERSION = %{ do "version.pl" or die $@ };
 my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
 my $R_V_SV  = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
 
 my ($SYMBIAN_ROOT, $SYMBIAN_VERSION, $SDK_NAME, $SDK_VARIANT, $SDK_VERSION) =
-    @{ do "sdk.pl" };
-my $UID  = do "uid.pl";
-my %PORT = %{ do "port.pl" };
+    @{ do "sdk.pl" or die $@ };
+my $UID  = do "uid.pl" or die $@;
+my %PORT = %{ do "port.pl" or die $@ };
 
 my $ARM = 'thumb'; # TODO
 my $S60SDK = $ENV{S60SDK}; # from sdk.pl
diff --git a/symbian/xsbuild.pl b/symbian/xsbuild.pl
index aee912a1ae..293e702eec 100644
--- a/symbian/xsbuild.pl
+++ b/symbian/xsbuild.pl
@@ -6,7 +6,7 @@ use Getopt::Long;
 use File::Basename;
 use Cwd;
 
-do "sanity.pl";
+do "sanity.pl" or die $@;
 
 my $CoreBuild = -d "ext" && -f "perl.h" && -d "symbian" && -f "perl.c";
 
@@ -64,13 +64,13 @@ my ($SYMBIAN_ROOT, $SYMBIAN_VERSION, $SDK_NAME, $SDK_VARIANT, $SDK_VERSION);
 
 if ($CoreBuild) {
     unshift @INC, "symbian";
-    do "sanity.pl";
-    my %VERSION = %{ do "version.pl" };
+    do "sanity.pl" or die $@;
+    my %VERSION = %{ do "version.pl" or die $@ };
     ($SYMBIAN_ROOT, $SYMBIAN_VERSION, $SDK_NAME, $SDK_VARIANT, $SDK_VERSION) =
-      @{ do "sdk.pl" };
+      @{ do "sdk.pl" or die $@ };
     $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
     $R_V_SV  = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
-    $BUILDROOT    = do "cwd.pl";
+    $BUILDROOT    = do "cwd.pl" or die $@;
     $PerlVersion    = $R_V_SV;
 }
 
diff --git a/t/comp/require.t b/t/comp/require.t
index d06834a3c5..bbc8ca0433 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -157,9 +157,9 @@ my $x = "ok $i\n";
 write_file("bleah.do", <<EOT);
 \$x = "not ok $i\\n";
 EOT
-do "bleah.do";
+do "bleah.do" or die $@;
 dofile();
-sub dofile { do "bleah.do"; };
+sub dofile { do "bleah.do" or die $@; };
 print $x;
 
 # Test that scalar context is forced for require
diff --git a/t/op/caller.t b/t/op/caller.t
index 5d27ea594b..5b5f62a255 100644
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -134,4 +134,4 @@ sub hint_fetch {
 
 $::testing_caller = 1;
 
-do './op/caller.pl';
+do './op/caller.pl' or die $@;
diff --git a/t/op/do.t b/t/op/do.t
index 9775331618..76d94c485a 100755
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -62,21 +62,21 @@ if (open(DO, ">$$.16")) {
     close DO or die "Could not close: $!";
 }
 
-my $a = do "$$.16";
+my $a = do "$$.16"; die $@ if $@;
 
 if (open(DO, ">$$.17")) {
     print DO "ok(1, 'do in list context') if defined wantarray &&     wantarray\n";
     close DO or die "Could not close: $!";
 }
 
-my @a = do "$$.17";
+my @a = do "$$.17"; die $@ if $@;
 
 if (open(DO, ">$$.18")) {
     print DO "ok(1, 'do in void context') if not defined wantarray\n";
     close DO or die "Could not close: $!";
 }
 
-do "$$.18";
+do "$$.18"; die $@ if $@;
 
 # bug ID 20010920.007
 eval qq{ do qq(a file that does not exist); };
diff --git a/t/op/inccode-tie.t b/t/op/inccode-tie.t
index 43388dd050..7f11004f94 100644
--- a/t/op/inccode-tie.t
+++ b/t/op/inccode-tie.t
@@ -8,7 +8,7 @@ tie @INC, 'Tie::StdArray';
 @INC = @orig_INC;
 for my $file ('./op/inccode.t', './t/op/inccode.t', ':op:inccode.t') {
     if (-r $file) {
-	do $file;
+	do $file or die $@;
 	exit;
     }
 }
diff --git a/t/op/regexp_noamp.t b/t/op/regexp_noamp.t
index 8a6dd28206..9aa00b50a9 100755
--- a/t/op/regexp_noamp.t
+++ b/t/op/regexp_noamp.t
@@ -3,7 +3,7 @@
 $skip_amp = 1;
 for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
   if (-r $file) {
-    do $file;
+    do $file or die $@;
     exit;
   }
 }
diff --git a/t/op/regexp_notrie.t b/t/op/regexp_notrie.t
index 28681da0c9..0968fcd33e 100644
--- a/t/op/regexp_notrie.t
+++ b/t/op/regexp_notrie.t
@@ -8,7 +8,7 @@ BEGIN {
 $qr = 1;
 for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
     if (-r $file) {
-	do $file;
+	do $file or die $@;
 	exit;
     }
 }
diff --git a/t/op/regexp_qr.t b/t/op/regexp_qr.t
index ed38822d4c..81ba14c6fe 100644
--- a/t/op/regexp_qr.t
+++ b/t/op/regexp_qr.t
@@ -3,7 +3,7 @@
 $qr = 1;
 for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
     if (-r $file) {
-	do $file;
+	do $file or die $@;
 	exit;
     }
 }
diff --git a/t/op/regexp_qr_embed.t b/t/op/regexp_qr_embed.t
index bcd51156de..d5f0844acc 100644
--- a/t/op/regexp_qr_embed.t
+++ b/t/op/regexp_qr_embed.t
@@ -4,7 +4,7 @@ $qr = 1;
 $qr_embed = 1;
 for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
     if (-r $file) {
-	do $file;
+	do $file or die $@;
 	exit;
     }
 }
diff --git a/t/op/regexp_trielist.t b/t/op/regexp_trielist.t
index 22f4f58f71..214e80bf79 100644
--- a/t/op/regexp_trielist.t
+++ b/t/op/regexp_trielist.t
@@ -8,7 +8,7 @@ BEGIN {
 $qr = 1;
 for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
     if (-r $file) {
-	do $file;
+	do $file or die $@;
 	exit;
     }
 }
diff --git a/t/op/threads.t b/t/op/threads.t
index 165c542bc0..43f6b07b68 100644
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -111,5 +111,5 @@ EOI
 # http://www.nntp.perl.org/group/perl.perl5.porters/63123
 fresh_perl_is(<<'EOI', 'ok', { }, 'Ensure PL_linestr can be cloned');
 use threads;
-print do 'op/threads_create.pl';
+print do 'op/threads_create.pl' || die $@;
 EOI
diff --git a/t/uni/case.pl b/t/uni/case.pl
index e27771b192..9d142ed685 100644
--- a/t/uni/case.pl
+++ b/t/uni/case.pl
@@ -23,7 +23,7 @@ sub casetest {
     my $file = File::Spec->catfile(File::Spec->catdir(File::Spec->updir,
 						      "lib", "unicore", "To"),
 				   "$base.pl");
-    my $simple = do $file;
+    my $simple = do $file or die $@;
     my %simple;
     for my $i (split(/\n/, $simple)) {
 	my ($k, $v) = split(' ', $i);
diff --git a/win32/ce-helpers/makedist.pl b/win32/ce-helpers/makedist.pl
index 1332d23475..85812673e4 100644
--- a/win32/ce-helpers/makedist.pl
+++ b/win32/ce-helpers/makedist.pl
@@ -237,7 +237,7 @@ sub bootstrap {
     my $bs = $file;
     $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/;
     if (-s $bs) { # only read file if it's not empty
-        eval { do $bs; };
+        do $bs;
         warn "$bs: $@\n" if $@;
     }