summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2014-08-09 22:09:17 -0700
committerFather Chrysostomos <sprout@cpan.org>2014-08-09 22:09:17 -0700
commit672794ca55bc11c78c1244bba9039f731071e1bf (patch)
tree241fbe3c02fcc944142b0c0082e7c68f1c36e6b8
parentf51551f7eae700328787f130fa35783726046e35 (diff)
downloadperl-672794ca55bc11c78c1244bba9039f731071e1bf.tar.gz
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.
-rw-r--r--pp_ctl.c3
-rw-r--r--t/op/require_override.t26
2 files changed, 27 insertions, 2 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index c8f49d7453..5e671eec02 100644
--- 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 40f794d068..7f9ee65e50 100644
--- 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");