do $file; won't propagate errors from die, as do is an implicit eval.
Nicholas Clark [Mon, 8 Jan 2007 21:20:26 +0000 (21:20 +0000)]
So need to propagate errors with $@.

p4raw-id: //depot/perl@29723

27 files changed:
ext/DynaLoader/hints/gnukfreebsd.pl
ext/DynaLoader/hints/gnuknetbsd.pl
ext/NDBM_File/hints/gnukfreebsd.pl
ext/NDBM_File/hints/gnuknetbsd.pl
ext/ODBM_File/hints/gnukfreebsd.pl
ext/ODBM_File/hints/gnuknetbsd.pl
ext/POSIX/hints/gnukfreebsd.pl
ext/POSIX/hints/gnuknetbsd.pl
ext/Storable/hints/gnukfreebsd.pl
ext/Storable/hints/gnuknetbsd.pl
lib/perl5db.pl
lib/utf8_heavy.pl
symbian/config.pl
symbian/makesis.pl
symbian/xsbuild.pl
t/comp/require.t
t/op/caller.t
t/op/do.t
t/op/inccode-tie.t
t/op/regexp_noamp.t
t/op/regexp_notrie.t
t/op/regexp_qr.t
t/op/regexp_qr_embed.t
t/op/regexp_trielist.t
t/op/threads.t
t/uni/case.pl
win32/ce-helpers/makedist.pl

index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index 6e37b40..db63567 100644 (file)
@@ -1 +1 @@
-do './hints/linux.pl';
+do './hints/linux.pl' or die $@;
index e031ac2..1b9f376 100644 (file)
@@ -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
index de4d01d..8a2ba71 100644 (file)
@@ -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
index 52b6e71..f35efb6 100644 (file)
@@ -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"
index dbf533c..377a7c7 100644 (file)
@@ -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
index aee912a..293e702 100644 (file)
@@ -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;
 }
 
index d06834a..bbc8ca0 100755 (executable)
@@ -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
index 5d27ea5..5b5f62a 100644 (file)
@@ -134,4 +134,4 @@ sub hint_fetch {
 
 $::testing_caller = 1;
 
-do './op/caller.pl';
+do './op/caller.pl' or die $@;
index 9775331..76d94c4 100755 (executable)
--- 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); };
index 43388dd..7f11004 100644 (file)
@@ -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;
     }
 }
index 8a6dd28..9aa00b5 100755 (executable)
@@ -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;
   }
 }
index 28681da..0968fcd 100644 (file)
@@ -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;
     }
 }
index ed38822..81ba14c 100644 (file)
@@ -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;
     }
 }
index bcd5115..d5f0844 100644 (file)
@@ -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;
     }
 }
index 22f4f58..214e80b 100644 (file)
@@ -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;
     }
 }
index 165c542..43f6b07 100644 (file)
@@ -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
index e27771b..9d142ed 100644 (file)
@@ -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);
index 1332d23..8581267 100644 (file)
@@ -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 $@;
     }