diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | mg.c | 10 | ||||
| -rw-r--r-- | proto.h | 4 | ||||
| -rw-r--r-- | t/op/tie.t | 8 | ||||
| -rw-r--r-- | t/op/ver.t | 6 |
6 files changed, 23 insertions, 9 deletions
@@ -1785,7 +1785,7 @@ sM |void |clear_placeholders |NN HV *hv|U32 items #endif #if defined(PERL_IN_MG_C) -s |void |save_magic |I32 mgs_ix|NN SV *sv +s |void |save_magic_flags|I32 mgs_ix|NN SV *sv|U32 flags -s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN SV *meth s |SV* |magic_methcall1|NN SV *sv|NN const MAGIC *mg \ |NN SV *meth|U32 flags \ @@ -1395,7 +1395,7 @@ #define magic_methcall1(a,b,c,d,e,f) S_magic_methcall1(aTHX_ a,b,c,d,e,f) #define magic_methpack(a,b,c) S_magic_methpack(aTHX_ a,b,c) #define restore_magic(a) S_restore_magic(aTHX_ a) -#define save_magic(a,b) S_save_magic(aTHX_ a,b) +#define save_magic_flags(a,b,c) S_save_magic_flags(aTHX_ a,b,c) #define unwind_handler_stack(a) S_unwind_handler_stack(aTHX_ a) # endif # if defined(PERL_IN_MG_C) || defined(PERL_IN_PP_C) @@ -90,13 +90,13 @@ struct magic_state { /* MGS is typedef'ed to struct magic_state in perl.h */ STATIC void -S_save_magic(pTHX_ I32 mgs_ix, SV *sv) +S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags) { dVAR; MGS* mgs; bool bumped = FALSE; - PERL_ARGS_ASSERT_SAVE_MAGIC; + PERL_ARGS_ASSERT_SAVE_MAGIC_FLAGS; assert(SvMAGICAL(sv)); @@ -120,12 +120,14 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) mgs->mgs_ss_ix = PL_savestack_ix; /* points after the saved destructor */ mgs->mgs_bumped = bumped; - SvMAGICAL_off(sv); + SvFLAGS(sv) &= ~flags; /* Turning READONLY off for a copy-on-write scalar (including shared hash keys) is a bad idea. */ if (!SvIsCOW(sv)) SvREADONLY_off(sv); } +#define save_magic(a,b) save_magic_flags(a,b,SVs_GMG|SVs_SMG|SVs_RMG) + /* =for apidoc mg_magical @@ -263,7 +265,7 @@ Perl_mg_set(pTHX_ SV *sv) if (PL_localizing == 2 && sv == DEFSV) return 0; - save_magic(mgs_ix, sv); + save_magic_flags(mgs_ix, sv, SVs_GMG|SVs_SMG); /* leave SVs_RMG on */ for (mg = SvMAGIC(sv); mg; mg = nextmg) { const MGVTBL* vtbl = mg->mg_virtual; @@ -5792,9 +5792,9 @@ STATIC int S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth) assert(sv); assert(mg); assert(meth) STATIC void S_restore_magic(pTHX_ const void *p); -STATIC void S_save_magic(pTHX_ I32 mgs_ix, SV *sv) +STATIC void S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags) __attribute__nonnull__(pTHX_2); -#define PERL_ARGS_ASSERT_SAVE_MAGIC \ +#define PERL_ARGS_ASSERT_SAVE_MAGIC_FLAGS \ assert(sv) STATIC void S_unwind_handler_stack(pTHX_ const void *p); diff --git a/t/op/tie.t b/t/op/tie.t index ad58af74c0..6ff5870ef6 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -1332,3 +1332,11 @@ Can't call method "FETCHSIZE" on an undefined value at - line 5. Can't call method "FETCHSIZE" on an undefined value at - line 6. Can't call method "FETCHSIZE" on an undefined value at - line 7. Can't call method "FETCHSIZE" on an undefined value at - line 8. +######## + +# Assigning vstrings to tied scalars +sub TIESCALAR{bless[]}; +sub STORE { print ref \$_[1], "\n" } +tie $x, ""; $x = v3; +EXPECT +VSTRING diff --git a/t/op/ver.t b/t/op/ver.t index 5fca6267a5..3969d11709 100644 --- a/t/op/ver.t +++ b/t/op/ver.t @@ -11,7 +11,7 @@ $DOWARN = 1; # enable run-time warnings now use Config; -plan( tests => 57 ); +plan( tests => 58 ); eval 'use v5.5.640'; is( $@, '', "use v5.5.640; $@"); @@ -276,6 +276,10 @@ is ref \$a, 'SCALAR', $a = v102; $a =~ y/f/g/; is ref \$a, 'SCALAR', 'y/// flattens vstrings'; +sub { $_[0] = v3; + is ref \$h{nonexistent}, 'VSTRING', 'defelems can pass vstrings' } +->($h{nonexistent}); + # The following tests whether v-strings are correctly # interpreted by the tokeniser when it's in a XTERMORDORDOR # state (fittingly, the only tokeniser state to contain the |