From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 6 Feb 2006 13:08:34 +0000 (+0000)
Subject: Fix bug #38439 - reference to typeglob assignment needs to be based
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=acaa9288c554316f43effec4957c68555702b76e;p=p5sagit%2Fp5-mst-13.2.git

Fix bug #38439 - reference to typeglob assignment needs to be based
on SvROK(sstr) rather than SvTYPE(sstr) == SVt_RV.

p4raw-id: //depot/perl@27104
---

diff --git a/sv.c b/sv.c
index 312cbd1..2bebce1 100644
--- a/sv.c
+++ b/sv.c
@@ -3266,21 +3266,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     case SVt_RV:
 	if (dtype < SVt_RV)
 	    sv_upgrade(dstr, SVt_RV);
-	else if (dtype == SVt_PVGV &&
-		 SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
-	    sstr = SvRV(sstr);
-	    if (sstr == dstr) {
-		if (GvIMPORTED(dstr) != GVf_IMPORTED
-		    && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-		{
-		    GvIMPORTED_on(dstr);
-		}
-		GvMULTI_on(dstr);
-		return;
-	    }
-	    S_glob_assign(aTHX_ dstr, sstr, dtype);
-	    return;
-	}
 	break;
     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -3343,6 +3328,22 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     sflags = SvFLAGS(sstr);
 
     if (sflags & SVf_ROK) {
+	if (dtype == SVt_PVGV &&
+	    SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
+	    sstr = SvRV(sstr);
+	    if (sstr == dstr) {
+		if (GvIMPORTED(dstr) != GVf_IMPORTED
+		    && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+		{
+		    GvIMPORTED_on(dstr);
+		}
+		GvMULTI_on(dstr);
+		return;
+	    }
+	    S_glob_assign(aTHX_ dstr, sstr, dtype);
+	    return;
+	}
+
 	if (dtype >= SVt_PV) {
 	    if (dtype == SVt_PVGV) {
 		S_pvgv_assign(aTHX_ dstr, sstr);
diff --git a/t/op/gv.t b/t/op/gv.t
index 2230baf..3164c35 100755
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 134 );
+plan( tests => 138 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -378,6 +378,25 @@ is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'plunk', "Value", "Constant has correct value");
 is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
 
+{
+    use vars qw($glook $smek $foof);
+    # Check reference assignment isn't affected by the SV type (bug #38439)
+    $glook = 3;
+    $smek = 4;
+    $foof = "halt and cool down";
+
+    my $rv = \*smek;
+    is($glook, 3);
+    *glook = $rv;
+    is($glook, 4);
+
+    my $pv = "";
+    $pv = \*smek;
+    is($foof, "halt and cool down");
+    *foof = $pv;
+    is($foof, 4);
+}
+
 format =
 .