From: Nicholas Clark Date: Mon, 8 Jan 2007 21:20:26 +0000 (+0000) Subject: do $file; won't propagate errors from die, as do is an implicit eval. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e81465beff59e6c9907613fe00ebce59d81fb1e8;p=p5sagit%2Fp5-mst-13.2.git 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 --- diff --git a/ext/DynaLoader/hints/gnukfreebsd.pl b/ext/DynaLoader/hints/gnukfreebsd.pl index 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 6e37b40..db63567 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 e031ac2..1b9f376 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2407,7 +2407,7 @@ Uses C 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. 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 de4d01d..8a2ba71 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 52b6e71..f35efb6 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 dbf533c..377a7c7 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 aee912a..293e702 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 d06834a..bbc8ca0 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -157,9 +157,9 @@ my $x = "ok $i\n"; write_file("bleah.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 43388dd..7f11004 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 8a6dd28..9aa00b5 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 28681da..0968fcd 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 ed38822..81ba14c 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 bcd5115..d5f0844 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 22f4f58..214e80b 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 165c542..43f6b07 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 e27771b..9d142ed 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 1332d23..8581267 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 $@; }