This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Call get-magic before rejecting non-refs in sv_bless
authorFather Chrysostomos <sprout@cpan.org>
Sat, 10 Aug 2013 20:09:34 +0000 (13:09 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 11 Aug 2013 17:53:35 +0000 (10:53 -0700)
Otherwise bless $tied_ref will die if FETCH hasn’t been called else-
where yet.

sv.c
t/op/bless.t

diff --git a/sv.c b/sv.c
index 9ea3182..9871b4e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9790,6 +9790,7 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
 
     PERL_ARGS_ASSERT_SV_BLESS;
 
+    SvGETMAGIC(sv);
     if (!SvROK(sv))
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
index 9d39326..4ab3e56 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (111);
+plan (112);
 
 sub expected {
     my($object, $package, $type) = @_;
@@ -154,3 +154,9 @@ for(__PACKAGE__) {
     like $@, qr/^Modification of a read-only value attempted/,
          'read-only COWs cannot be blessed';
 }
+
+sub TIESCALAR { bless \(my $thing = pop), shift }
+sub FETCH { ${$_[0]} }
+tie $tied, main => $untied = [];
+eval { bless $tied };
+is ref $untied, "main", 'blessing through tied refs' or diag $@;