[perl #119809] Disallow bless($ref, $tied_ref)

There is no reason tied (or otherwise magical variables like $/)
should be exempt from the ‘Attempt to bless into a reference’ error.

diff --git a/MANIFEST b/MANIFEST
index 33df1b3..2d94da4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4905,6 +4905,7 @@ t/lib/compmod.pl          Helper for 1_compile.t
 t/lib/Count.pm                 Helper for t/op/method.t
 t/lib/croak/mg                 Test croak calls from mg.c
 t/lib/croak/op                 Test croak calls from op.c
+t/lib/croak/pp                 Test croak calls from pp.c
 t/lib/croak/pp_ctl             Test croak calls from pp_ctl.c
 t/lib/croak/pp_hot             Test croak calls from pp_hot.c
 t/lib/croak.t                  Test calls to Perl_croak() in the C source.

diff --git a/pp.c b/pp.c
index f1f224e..f899a3f 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -616,9 +616,10 @@ PP(pp_bless)
        const char *ptr;
 
        if (!ssv) goto curstash;
-       if (!SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+       SvGETMAGIC(ssv);
+       if (!SvAMAGIC(ssv) && SvROK(ssv))
            Perl_croak(aTHX_ "Attempt to bless into a reference");
-       ptr = SvPV_const(ssv,len);
+       ptr = SvPV_nomg_const(ssv,len);
        if (len == 0)
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
                           "Explicit blessing to '' (assuming package main)");

diff --git a/t/lib/croak/pp b/t/lib/croak/pp
new file mode 100644 (file)
index 0000000..91fa40f
--- /dev/null
+++ b/t/lib/croak/pp
@@ -0,0 +1,14 @@
+__END__
+# NAME [perl #119809] Attempt to bless into a reference (tied)
+sub TIESCALAR { bless [] }
+sub FETCH { [] }
+tie $t, "";
+bless({}, $t);
+EXPECT
+Attempt to bless into a reference at - line 4.
+########
+# NAME [perl #119809] Attempt to bless into a reference (magical)
+$/ = \1;
+bless [], $/
+EXPECT
+Attempt to bless into a reference at - line 2.