From: Vincent Pit <vince@profvince.com>
Date: Fri, 16 Apr 2010 20:47:34 +0000 (+0200)
Subject: Be stricter about what localize_elem() accepts
X-Git-Tag: v0.11~7
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=965e21f781c23f8c20242d17d7db745d8c035eb3

Be stricter about what localize_elem() accepts
---

diff --git a/Upper.xs b/Upper.xs
index ba8b7b4..5bf3b49 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -1031,11 +1031,17 @@ PREINIT:
  I32 cxix;
  su_ud_localize *ud;
 CODE:
+ if (SvTYPE(sv) >= SVt_PVGV)
+  croak("Can't infer the element localization type from a glob and the value");
  SU_GET_CONTEXT(3, 3);
  Newx(ud, 1, su_ud_localize);
  SU_UD_ORIGIN(ud)  = NULL;
  SU_UD_HANDLER(ud) = su_localize;
  su_ud_localize_init(ud, sv, val, elem);
+ if (ud->type != SVt_PVAV && ud->type != SVt_PVHV) {
+  Safefree(ud);
+  croak("Can't localize an element of something that isn't an array or a hash");
+ }
  su_init(cxix, ud, 4);
 
 void
diff --git a/lib/Scope/Upper.pm b/lib/Scope/Upper.pm
index 67cc80f..f49ba01 100644
--- a/lib/Scope/Upper.pm
+++ b/lib/Scope/Upper.pm
@@ -202,7 +202,8 @@ Although I believe it shouldn't be a problem as glob slots definedness is pretty
 =head2 C<localize_elem $what, $key, $value, $context>
 
 Introduces a C<local $what[$key] = $value> or C<local $what{$key} = $value> delayed to the time of first return into the upper scope denoted by C<$context>.
-Just like for L</localize>, the type of localization is determined from which kind of reference C<$value> is when C<$what> is a glob, and from the sigil when it's a string.
+Unlike L</localize>, C<$what> must be a string and the type of localization is inferred from its sigil.
+The two only valid types are array and hash ; for anything besides those, L</localize_elem> will throw an exception.
 C<$key> is either an array index or a hash key, depending of which kind of variable you localize.
 
 If C<$what> is a string pointing to an undeclared variable, the variable will be vivified as soon as the localization occurs and emptied when it ends, although it will still exist in its glob.
diff --git a/t/30-localize_elem-target.t b/t/30-localize_elem-target.t
index 273eb0d..5db7d0b 100644
--- a/t/30-localize_elem-target.t
+++ b/t/30-localize_elem-target.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 25;
+use Test::More tests => 25 + 8;
 
 use Scope::Upper qw/localize_elem UP HERE/;
 
@@ -127,3 +127,62 @@ our %h;
  is_deeply eval('*nonexistent{HASH}'), { },
                           'localize_elem "%nonexistent", "a", 13 => HERE [end]';
 }
+
+my $invalid_glob = qr/^Can't infer the element localization type from a glob and the value/;
+my $invalid_type = qr/^Can't localize an element of something that isn't an array or a hash/;
+
+{
+ local *x;
+
+ eval { localize_elem '$x', 0, 1 };
+ like $@, $invalid_type, 'invalid localize_elem "$x", 0, 1';
+}
+
+{
+ local *x;
+
+ eval { localize_elem '&x', 0, sub { } };
+ like $@, $invalid_type, 'invalid localize_elem "&x", 0, sub { }';
+}
+
+{
+ local *x;
+
+ eval { localize_elem '*x', 0, \1 };
+ like $@, $invalid_type, 'invalid localize_elem "*x", 0, \1';
+}
+
+{
+ local *x;
+
+ eval { localize_elem *x, 0, \1 };
+ like $@, $invalid_glob, 'invalid localize_elem *x, 0, \1';
+}
+
+{
+ local *x;
+
+ eval { localize_elem *x, 0, [ 1 ] };
+ like $@, $invalid_glob, 'invalid localize_elem *x, 0, [ 1 ]';
+}
+
+{
+ local *x;
+
+ eval { localize_elem *x, 0, { a => 1 } };
+ like $@, $invalid_glob, 'invalid localize_elem *x, 0, { a => 1 }';
+}
+
+{
+ local *x;
+
+ eval { localize_elem *x, 0, sub { } };
+ like $@, $invalid_glob, 'invalid localize_elem *x, 0, sub { }';
+}
+
+{
+ local *x;
+
+ eval { localize_elem *x, 0, *x };
+ like $@, $invalid_glob, 'invalid localize_elem *x, 0, *x';
+}