]> git.vpit.fr Git - perl/modules/Scope-Upper.git/commitdiff
Disallow reference localization targets
authorVincent Pit <vince@profvince.com>
Fri, 16 Apr 2010 21:00:59 +0000 (23:00 +0200)
committerVincent Pit <vince@profvince.com>
Fri, 16 Apr 2010 21:01:07 +0000 (23:01 +0200)
Upper.xs
t/20-localize-target.t
t/30-localize_elem-target.t
t/40-localize_delete-target.t

index 5bf3b496797c67bf67de422a6679e78e27382f3d..75c50934fa9abb290200ffc25dd5a496dde41346 100644 (file)
--- 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;
index 726a588d156763797c0f3523ae2556b305dcb14f..136feb6eed60e920ecaaac262e089fb4a3f5015d 100644 (file)
@@ -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';
+}
index 5db7d0b808c5227b5884174158c0e994ad02c835..1e6e975c468cc82dd747ba72974c736744d05458 100644 (file)
@@ -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';
+}
index b51c28b5b9339ea232d78da34aefac863d903006..c5abf9d8bbf7afcf39774c5afb4888adac229fac 100644 (file)
@@ -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';
+}