From: Vincent Pit Date: Sat, 26 Feb 2011 23:03:30 +0000 (+0100) Subject: Compatibility fix for perl 5.13.10 X-Git-Tag: rt64997^0 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=053dfd24ee61e5bcae61562722bd1cb95ef84ac2;p=perl%2Fmodules%2FScope-Upper.git Compatibility fix for perl 5.13.10 This solves RT #64997. --- diff --git a/Upper.xs b/Upper.xs index 682aa87..999eaba 100644 --- a/Upper.xs +++ b/Upper.xs @@ -316,6 +316,45 @@ STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV *val) { } } +/* ... Saving code slots from a glob ....................................... */ + +#if SU_HAS_PERL(5, 13, 10) + +/* Since perl 5.13.10, GvCV() is only a rvalue so we no longer can store a + * pointer to the gvcv member of the gv. */ + +typedef struct { + GV *gv; + CV *old_cv; +} su_save_gvcv_ud; + +STATIC void su_restore_gvcv(pTHX_ void *ud_) { + su_save_gvcv_ud *ud = ud_; + + GvCV_set(ud->gv, ud->old_cv); + + Safefree(ud); +} + +STATIC void su_save_gvcv(pTHX_ GV *gv) { +#define su_save_gvcv(gv) su_save_gvcv(aTHX_ (gv)) + su_save_gvcv_ud *ud; + + Newx(ud, 1, su_save_gvcv_ud); + ud->gv = gv; + ud->old_cv = GvCV(gv); + + GvCV_set(gv, NULL); + + SAVEDESTRUCTOR_X(su_restore_gvcv, ud); +} + +#else + +#define su_save_gvcv(gv) SAVESPTR(GvCV(gv)), GvCV_set((gv), NULL) + +#endif + /* --- Actions ------------------------------------------------------------- */ typedef struct { @@ -549,8 +588,7 @@ STATIC void su_localize(pTHX_ void *ud_) { save_gp(gv, 1); /* hide previous entry in symtab */ break; case SVt_PVCV: - SAVESPTR(GvCV(gv)); - GvCV_set(gv, NULL); + su_save_gvcv(gv); break; default: gv = (GV *) save_scalar(gv); diff --git a/t/20-localize-target.t b/t/20-localize-target.t index 9bd7a38..40d8f65 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 + 4; +use Test::More tests => 61 + 4; use Scope::Upper qw/localize UP HERE/; @@ -255,6 +255,45 @@ my $xh = { a => 5, c => 7 }; is foo(), 8, 'localize "&foo", sub { 8 } => UP [ok]'; } +{ + local *foo = sub { 'a' }; + { + { + localize *foo, sub { 'b' } => UP; + is foo(), 'a', 'localize *foo, sub { "b" } => UP [not yet 1]'; + { + no warnings 'redefine'; + local *foo = sub { 'c' }; + is foo(), 'c', 'localize *foo, sub { "b" } => UP [localized 1]'; + } + is foo(), 'a', 'localize *foo, sub { "b" } => UP [not yet 2]'; + } + is foo(), 'b', 'localize *foo, sub { "b" } => UP [ok 1]'; + { + no warnings 'redefine'; + local *foo = sub { 'd' }; + is foo(), 'd', 'localize *foo, sub { "b" } => UP [localized 2]'; + } + is foo(), 'b', 'localize *foo, sub { "b" } => UP [ok 2]'; + } + is foo(), 'a', 'localize *foo, sub { "b" } => UP [end]'; +} + +{ + local *foo = sub { 'x' }; + { + { + localize *foo, sub { 'y' } => UP; + is foo(), 'x', 'localize *foo, sub { "y" } => UP [not yet]'; + } + is foo(), 'y', 'localize *foo, sub { "y" } => UP [ok]'; + no warnings 'redefine'; + *foo = sub { 'z' }; + is foo(), 'z', 'localize *foo, sub { "y" } => UP [replaced]'; + } + is foo(), 'x', 'localize *foo, sub { "y" } => UP [end]'; +} + # Invalid sub invalid_ref { qr/^Invalid \Q$_[0]\E reference as the localization target/ }