From: Vincent Pit 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/?a=commitdiff_plain;h=59a1136cba8ac79b0428d55824873b55a9b700aa;p=perl%2Fmodules%2FScope-Upper.git 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'; +}