Make ‘require $tied_undef’ behave consistently

As of f04d2c345 perl does not give uninitialized warnings for ‘require
undef’.  But the check was not happening soon enough, causing tied
variables to behave erratically:

$ ./perl -Ilib -we 'sub TIESCALAR{bless[]}sub FETCH{undef}sub STORE{}tie $x,""; $x="a"; require $x'
Use of uninitialized value $x in require at -e line 1.
Missing or undefined argument to require at -e line 1.

(Uninit warning where muggle variables lack one.)

$ ./perl -Ilib -we 'sub TIESCALAR{bless[]}sub FETCH{undef}sub STORE{}tie $x,""; $x=3; require $x'
Invalid version format (non-numeric data) at -e line 1.

(undef being treated as a version string.)

We have to call get-magic on the argument before we check its
definedness.

diff --git a/pp_ctl.c b/pp_ctl.c
index c8f49d7..5e671ee 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3680,6 +3680,7 @@ PP(pp_require)
     bool path_searchable;
 
     sv = POPs;
+    SvGETMAGIC(sv);
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
        sv = sv_2mortal(new_version(sv));
        if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
@@ -3739,7 +3740,7 @@ PP(pp_require)
     }
     if (!SvOK(sv))
         DIE(aTHX_ "Missing or undefined argument to require");
-    name = SvPV_const(sv, len);
+    name = SvPV_nomg_const(sv, len);
     if (!(name && len > 0 && *name))
         DIE(aTHX_ "Missing or undefined argument to require");
 

diff --git a/t/op/require_override.t b/t/op/require_override.t
index 40f794d..7f9ee65 100644 (file)
--- a/t/op/require_override.t
+++ b/t/op/require_override.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 6);
+plan(tests => 10);
 
 my @warns;
 local $SIG{__WARN__}= sub { push @warns, $_[0] };
@@ -21,6 +21,30 @@ like($error, qr/Missing or undefined argument to require/, "Make sure we got the
 @warns= ();
 $error= undef;
 
+sub TIESCALAR{bless[]}
+sub STORE{}
+sub FETCH{}
+tie my $x, "";
+$x = "x";
+eval 'require $x; 1' or $error = $@;
+ok(0 == @warns,
+  'no warnings from require $tied_undef_after_str_assignment');
+like($error, qr/^Missing or undefined argument to require/,
+    "Make sure we got the error we expect");
+
+@warns= ();
+$error= undef;
+
+$x = 3;
+eval 'require $x; 1' or $error = $@;
+ok(0 == @warns,
+  'no warnings from require $tied_undef_after_num_assignment');
+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");