Better handling of magic methods freeing the SV

This is a fix for RT #81230 (and more). Currently, mg_get() works around
the case where the called magic (e.g. FETCH) frees the magic SV. It does
this by unconditionally pushing the SV on the tmps stack before invoking
the method.

There are two issues with this. Firstly, it may artificially extend the
life of the SV. This was the root of the problem with #81230. There, the
DB_File code, under -T, created a tainted tied object. Accessing the
object (within FETCH as it happens), caused mg_get() to be invoked on the
object (due to the taint magic), and thus extend the life of the object.
This then caused c<untie %h if $h{k}> to give the warning
    untie attempted while 1 inner references still exist.
This only became noticeable after efaf36747029c85b4d8825318cb4d485a0bb350e,
which stopped wrapping magic method calls in SAVETMPS/FREETMPS.

The second issue issue that this protection only applies to mg_get();
functions like mg_set() can still segfault if the SV is deleted.

This commit fixes both problems as follows:

First, the protection mechanism is moved out of mg_get() and into
save_magic() / restore_magic(), so that it protects more things.
Secondly, the protection is now:

* in save_magic(), SvREFCNT_inc() the SV, thus protecting it from being
  freed during FETCH (or whatever)

* in restore_magic(), SvREFCNT_dec() the SV, undoing the protection
  without extending the life of the SV, *except* if the refcount is
  1 (ie FETCH tried to free it), then push it on the mortals stack
  to extend it life a bit so our callers wont choke on it.

2 files changed, 60 insertions, 1 deletions

diff --git a/t/op/taint.t b/t/op/taint.t
index 78b3d5591f..fc2fcd74bb 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 338;
+plan tests => 339;
 
 $| = 1;
 
@@ -1445,6 +1445,32 @@ end
     ok(! tainted($b), "regex optimization of single char /[]/i doesn't taint");
 }
 
+{
+    # RT 81230: tainted value during FETCH created extra ref to tied obj
+
+    package P81230;
+    use warnings;
+
+    my %h;
+
+    sub TIEHASH {
+	my $x = $^X; # tainted
+	bless  \$x;
+    }
+    sub FETCH { my $x = $_[0]; $$x . "" }
+
+    tie %h, 'P81230';
+
+    my $w = "";
+    local $SIG{__WARN__} = sub { $w .= "@_" };
+
+    untie %h if $h{"k"};
+
+    ::is($w, "", "RT 81230");
+}
+
+
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};
diff --git a/t/op/tie.t b/t/op/tie.t
index b68102e3b3..98f42799b9 100644
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -962,3 +962,36 @@ EXPECT
 ok tie
 ok tied
 ok untie
+########
+#
+# STORE freeing tie'd AV
+sub TIEARRAY  { bless [] }
+sub STORE     { *a = []; 1 }
+sub STORESIZE { }
+sub EXTEND    { }
+tie @a, 'main';
+$a[0] = 1;
+EXPECT
+########
+#
+# CLEAR freeing tie'd AV
+sub TIEARRAY  { bless [] }
+sub CLEAR     { *a = []; 1 }
+sub STORESIZE { }
+sub EXTEND    { }
+sub STORE     { }
+tie @a, 'main';
+@a = (1,2,3);
+EXPECT
+########
+#
+# FETCHSIZE freeing tie'd AV
+sub TIEARRAY  { bless [] }
+sub FETCHSIZE { *a = []; 100 }
+sub STORESIZE { }
+sub EXTEND    { }
+sub STORE     { }
+tie @a, 'main';
+print $#a,"\n"
+EXPECT
+99