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.

diff --git a/MANIFEST b/MANIFEST
index 47a0a8d..b63c75b 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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");
+
+
+