From: Vincent Pit <vince@profvince.com>
Date: Fri, 16 Apr 2010 21:00:59 +0000 (+0200)
Subject: Disallow reference localization targets
X-Git-Tag: v0.11~6
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=59a1136cba8ac79b0428d55824873b55a9b700aa

Disallow reference localization targets
---

diff --git a/Upper.xs b/Upper.xs
index 5bf3b49..75c5093 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -380,6 +380,9 @@ STATIC void su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *e
    t = SvTYPE(SvRV(val));
    deref = 1;
   }
+ } else if (SvROK(sv)) {
+  croak("Invalid %s reference as the localization target",
+                 sv_reftype(SvRV(sv), 0));
  } else {
   STRLEN len, l;
   const char *p = SvPV_const(sv, len), *s;
diff --git a/t/20-localize-target.t b/t/20-localize-target.t
index 726a588..136feb6 100644
--- a/t/20-localize-target.t
+++ b/t/20-localize-target.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 50;
+use Test::More tests => 50 + 4;
 
 use Scope::Upper qw/localize UP HERE/;
 
@@ -254,3 +254,27 @@ my $xh = { a => 5, c => 7 };
  }
  is foo(), 8, 'localize "&foo", sub { 8 } => UP [ok]';
 }
+
+# Invalid
+
+sub invalid_ref { qr/^Invalid \Q$_[0]\E reference as the localization target/ }
+
+{
+ eval { localize \1, 0 => HERE };
+ like $@, invalid_ref('SCALAR'), 'invalid localize \1, 0 => HERE';
+}
+
+{
+ eval { localize [ ], 0 => HERE };
+ like $@, invalid_ref('ARRAY'),  'invalid localize [ ], 0 => HERE';
+}
+
+{
+ eval { localize { }, 0 => HERE };
+ like $@, invalid_ref('HASH'),   'invalid localize { }, 0 => HERE';
+}
+
+{
+ eval { localize sub { }, 0 => HERE };
+ like $@, invalid_ref('CODE'),   'invalid localize sub { }, 0 => HERE';
+}
diff --git a/t/30-localize_elem-target.t b/t/30-localize_elem-target.t
index 5db7d0b..1e6e975 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 + 8;
+use Test::More tests => 25 + 12;
 
 use Scope::Upper qw/localize_elem UP HERE/;
 
@@ -128,6 +128,8 @@ our %h;
                           'localize_elem "%nonexistent", "a", 13 => HERE [end]';
 }
 
+# Invalid
+
 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/;
 
@@ -186,3 +188,25 @@ my $invalid_type = qr/^Can't localize an element of something that isn't an arra
  eval { localize_elem *x, 0, *x };
  like $@, $invalid_glob, 'invalid localize_elem *x, 0, *x';
 }
+
+sub invalid_ref { qr/^Invalid \Q$_[0]\E reference as the localization target/ }
+
+{
+ eval { localize_elem \1, 0, 0 => HERE };
+ like $@, invalid_ref('SCALAR'), 'invalid localize_elem \1, 0, 0 => HERE';
+}
+
+{
+ eval { localize_elem [ ], 0, 0 => HERE };
+ like $@, invalid_ref('ARRAY'),  'invalid localize_elem [ ], 0, 0 => HERE';
+}
+
+{
+ eval { localize_elem { }, 0, 0 => HERE };
+ like $@, invalid_ref('HASH'),   'invalid localize_elem { }, 0, 0 => HERE';
+}
+
+{
+ eval { localize_elem sub { }, 0, 0 => HERE };
+ like $@, invalid_ref('CODE'),   'invalid localize_elem sub { }, 0, 0 => HERE';
+}
diff --git a/t/40-localize_delete-target.t b/t/40-localize_delete-target.t
index b51c28b..c5abf9d 100644
--- a/t/40-localize_delete-target.t
+++ b/t/40-localize_delete-target.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 44;
+use Test::More tests => 44 + 4;
 
 use Scope::Upper qw/localize_delete UP HERE/;
 
@@ -205,3 +205,27 @@ is x(), 1, 'localize_delete "&x", anything => HERE [end]';
 }
 is x(), 1, 'localize_delete *x, anything => HERE [end 1]';
 is $x,  1, 'localize_delete *x, anything => HERE [end 2]';
+
+# Invalid
+
+sub invalid_ref { qr/^Invalid \Q$_[0]\E reference as the localization target/ }
+
+{
+ eval { localize_delete \1, 0 => HERE };
+ like $@, invalid_ref('SCALAR'), 'invalid localize_delete \1, 0 => HERE';
+}
+
+{
+ eval { localize_delete [ ], 0 => HERE };
+ like $@, invalid_ref('ARRAY'),  'invalid localize_delete [ ], 0 => HERE';
+}
+
+{
+ eval { localize_delete { }, 0 => HERE };
+ like $@, invalid_ref('HASH'),   'invalid localize_delete { }, 0 => HERE';
+}
+
+{
+ eval { localize_delete sub { }, 0 => HERE };
+ like $@, invalid_ref('CODE'),   'invalid localize_delete sub { }, 0 => HERE';
+}