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 (file)
--- 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 (executable)
--- 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 =
 .