From: Vincent Pit Date: Sun, 26 Aug 2018 19:08:19 +0000 (+0200) Subject: Always apply localizations at the glob level X-Git-Tag: rt125931^0 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=d0000ba43a773bbbdfd7cbf8b4414a99cedb6391;p=perl%2Fmodules%2FScope-Upper.git Always apply localizations at the glob level "localize '$x', $var" used to dereference $var and apply the localization to $x directly. This did not set the IMPORTED flag on *x when necessary. In order to fix this, we now follow the opposite logic : $var is now referenced when the localization target is a scalar, and that reference is assigned to *x so that localize now really behaves like "local *x = $var". This fixes [RT #125931]. --- diff --git a/Upper.xs b/Upper.xs index 6f28120..5ab2040 100644 --- a/Upper.xs +++ b/Upper.xs @@ -808,25 +808,31 @@ typedef struct { static I32 su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *elem) { #define su_ud_localize_init(UD, S, V, E) su_ud_localize_init(aTHX_ (UD), (S), (V), (E)) - UV deref = 0; - svtype t = SVt_NULL; - I32 size; + int take_ref = 0; + svtype t = SVt_NULL; + I32 size; SvREFCNT_inc_simple_void(sv); if (SvTYPE(sv) >= SVt_PVGV) { + if (SvFAKE(sv)) { + sv_force_normal(sv); + goto string_spec; + } + if (!val || !SvROK(val)) { /* local *x; or local *x = $val; */ t = SVt_PVGV; } else { /* local *x = \$val; */ 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; + const char *p, *s; +string_spec: + p = SvPV_const(sv, len); for (s = p, l = len; l > 0 && isSPACE(*s); ++s, --l) { } if (!l) { l = len; @@ -842,14 +848,17 @@ static I32 su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *el if (t != SVt_NULL) { ++s; --l; + if (t == SVt_PV) + take_ref = 1; } else if (val) { /* t == SVt_NULL, type can't be inferred from the sigil */ if (SvROK(val) && !sv_isobject(val)) { t = SvTYPE(SvRV(val)); - deref = 1; } else { t = SvTYPE(val); + take_ref = 1; } } + SvREFCNT_dec(sv); sv = newSVpvn(s, l); } @@ -858,31 +867,31 @@ static I32 su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *el case SVt_PVAV: size = elem ? SU_SAVE_AELEM_OR_ADELETE_SIZE : SU_SAVE_ARY_SIZE; - deref = 0; break; case SVt_PVHV: size = elem ? SU_SAVE_HELEM_OR_HDELETE_SIZE : SU_SAVE_HASH_SIZE; - deref = 0; break; case SVt_PVGV: size = SU_SAVE_GP_SIZE; - deref = 0; break; case SVt_PVCV: size = SU_SAVE_GVCV_SIZE; - deref = 0; break; default: size = SU_SAVE_SCALAR_SIZE; break; } - /* When deref is set, val isn't NULL */ SU_UD_PRIVATE(ud) = t; ud->sv = sv; - ud->val = val ? newSVsv(deref ? SvRV(val) : val) : NULL; + if (val) { + val = newSVsv(val); + ud->val = take_ref ? newRV_noinc(val) : val; + } else { + ud->val = NULL; + } ud->elem = SvREFCNT_inc(elem); return size; @@ -957,7 +966,7 @@ static void su_localize(pTHX_ void *ud_) { su_save_gvcv(gv); break; default: - gv = (GV *) save_scalar(gv); + save_scalar(gv); break; } diff --git a/t/20-localize-target.t b/t/20-localize-target.t index c68a1a3..e16fa4c 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 => 70 + 4; +use Test::More tests => 70 + 2 * 5 + 4; use Scope::Upper qw; @@ -333,6 +333,42 @@ sub X::foo { 'X::foo' } is(Y->foo, 'X::foo', 'localize "Y::foo", sub { "Y::foo" } => UP [end]'); } +# Import + +sub is_imported { + my ($pkg, $sig, $val) = @_; + my $exp = $sig eq '$' ? \$val : $val; + my $var = 'daffodil'; # don't use 'x' or eval will capture $main::x + my $spec = $sig . $pkg . '::' . $var; + localize $spec, $val => HERE; + { + my $desc = "localize imported ${sig}${var} to $val"; + my $got = eval "package $pkg; \\${sig}${var}"; + if ($@) { + fail "$desc test did not compile: $@"; + } else { + is_deeply $got, $exp, $desc; + } + } + { + my $desc = "localize defined ${sig}${var} to $val"; + my $got = eval "\\${sig}${pkg}::${var}"; + if ($@) { + fail "$desc test did not compile: $@"; + } else { + is_deeply $got, $exp, $desc; + } + } +} + +{ + is_imported 'Scope::Upper::Test::Mock10', '$', 0; + is_imported 'Scope::Upper::Test::Mock11', '$', \1; + is_imported 'Scope::Upper::Test::Mock12', '@', [ 2, 3 ]; + is_imported 'Scope::Upper::Test::Mock13', '%', { a => 4 }; + is_imported 'Scope::Upper::Test::Mock14', '&', sub { 5 }; +} + # Invalid sub invalid_ref { qr/^Invalid \Q$_[0]\E reference as the localization target/ }