In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/f04d2c345149d984ed5180f12fa007908c91b131?hp=57d69a4016b981268198cf744741335a9b1fbb23>
- Log -----------------------------------------------------------------
commit f04d2c345149d984ed5180f12fa007908c91b131
Author: Yves Orton <demer...@gmail.com>
Date: Wed Jul 30 15:44:44 2014 +0200
make "require" handle no argument more gracefully, and add tests
in Perl 5.14 the following segfaults:
*CORE::GLOBAL::require = sub { }; eval "require";
in Perl 5.18
perl -wle'eval "require";'
produces a spurious warning:
Use of uninitialized value $_ in require at (eval 1) line 1.
In other perls:
perl -e 'eval q/require $this/ or print $@'
produces:
Null filename used at (eval 1) line 1.
The error message is crappy, totally unfit for a perl audience,
and the spurious warning is just confusing. There is no $_ in use
here, why do we warn about it.
It looks like 9e3fb20c fixed the segfault (by accident), and also
somehow meant that the "Null filename" error would not ever be
produced.
So this patch ditches the crappy error and replaces it with something
meaningful and informative, and tests that we do not regress and start
segfaulting again.
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
pod/perldiag.pod | 7 ++++---
pp_ctl.c | 5 ++++-
t/op/require_override.t | 35 +++++++++++++++++++++++++++++++++++
4 files changed, 44 insertions(+), 4 deletions(-)
create mode 100644 t/op/require_override.t
diff --git a/MANIFEST b/MANIFEST
index 47a0a8d..b63c75b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5142,6 +5142,7 @@ t/op/ref.t See if refs and objects
work
t/op/repeat.t See if x operator works
t/op/require_37033.t See if require always closes rsfp
t/op/require_errors.t See if errors from require are reported
correctly
+t/op/require_override.t See if require handles no argument properly
t/op/reset.t See if reset operator works
t/op/reverse.t See if reverse operator works
t/op/rt119311.t Test bug #119311 (die/DESTROY/recursion)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index be29485..e41c8cc 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3617,10 +3617,11 @@ to UTC. If it's not, define the logical name
F<SYS$TIMEZONE_DIFFERENTIAL> to translate to the number of seconds which
need to be added to UTC to get local time.
-=item Null filename used
+=item Missing or undefined argument to require
-(F) You can't require the null filename, especially because on many
-machines that means the current directory! See L<perlfunc/require>.
+(F) You tried to call require with no argument or with an undefined
+value as an argument. Require expects either a package name or a
+file-specification as an argument. See L<perlfunc/require>.
=item NULL OP IN RUN
diff --git a/pp_ctl.c b/pp_ctl.c
index 7d098b7..c8f49d7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3737,9 +3737,12 @@ PP(pp_require)
RETPUSHYES;
}
+ if (!SvOK(sv))
+ DIE(aTHX_ "Missing or undefined argument to require");
name = SvPV_const(sv, len);
if (!(name && len > 0 && *name))
- DIE(aTHX_ "Null filename used");
+ DIE(aTHX_ "Missing or undefined argument to require");
+
if (!IS_SAFE_PATHNAME(name, len, "require")) {
DIE(aTHX_ "Can't locate %s: %s",
pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
diff --git a/t/op/require_override.t b/t/op/require_override.t
new file mode 100644
index 0000000..40f794d
--- /dev/null
+++ b/t/op/require_override.t
@@ -0,0 +1,35 @@
+#!perl
+use strict;
+use warnings;
+
+BEGIN {
+ chdir 't';
+ require './test.pl';
+}
+
+plan(tests => 6);
+
+my @warns;
+local $SIG{__WARN__}= sub { push @warns, $_[0] };
+my $error;
+
+eval "require; 1" or $error = $@;
+ok(1, "Check that eval 'require' does not segv");
+ok(0 == @warns, "We expect the eval to die, without producing warnings");
+like($error, qr/Missing or undefined argument to require/, "Make sure we got
the error we expect");
+
+@warns= ();
+$error= undef;
+
+*CORE::GLOBAL::require = *CORE::GLOBAL::require = sub { };
+eval "require; 1" or $error = $@;
+ok(1, "Check that eval 'require' on overloaded require does not segv");
+ok(0 == @warns, "We expect the eval to die, without producing warnings");
+
+# NOTE! The following test does NOT represent a commitment or promise that the
following logic is
+# the *right* thing to do. It may well not be. But this is how it works now,
and we want to test it.
+# IOW, do not use this test as the basis to argue that this is how it SHOULD
work. Thanks, yves.
+ok(!defined($error), "We do not expect the overloaded version of require to
die from no arguments");
+
+
+
--
Perl5 Master Repository
