diff options
| -rw-r--r-- | mg.c | 6 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rwxr-xr-x | t/op/tie.t | 9 |
3 files changed, 21 insertions, 0 deletions
@@ -133,6 +133,12 @@ Perl_mg_get(pTHX_ SV *sv) if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg); + + /* guard against sv having been freed */ + if (SvTYPE(sv) == SVTYPEMASK) { + Perl_croak(aTHX_ "Tied variable freed while still in use"); + } + /* Don't restore the flags for this entry if it was deleted. */ if (mg->mg_flags & MGf_GSKIP) (SSPTR(mgs_ix, MGS *))->mgs_flags = 0; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3881288f78..cb314e976d 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3672,6 +3672,12 @@ target of the change to (F) The entry point function of threads->create() failed for some reason. +=item Tied variable freed while still in use + +(F) An access method for a tied variable (e.g. FETCH) did something to +free the variable. Since continuing the current operation is likely +to result in a coredump, Perl is bailing out instead. + =item times not implemented (F) Your version of the C library apparently doesn't do times(). I diff --git a/t/op/tie.t b/t/op/tie.t index 6e73ceec85..49c189e66f 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -286,3 +286,12 @@ EXPECT 7 8 0 +######## +# +# FETCH freeing tie'd SV +sub TIESCALAR { bless [] } +sub FETCH { *a = \1; 1 } +tie $a, 'main'; +print $a; +EXPECT +Tied variable freed while still in use at - line 6. |