From c2f922f11b8978a4eea0e0d28626dd3c1f6eaba7 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 21 Aug 2011 10:57:34 -0700 Subject: [PATCH] &CORE::bless() MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit This commit allows &CORE::bless to be called through references and via ampersand syntax. pp_bless is modified to take into account the nulls pushed on to the stack in pp_coreargs, since pp_coreargs has no other way to tell bless how many arguments it’s actually getting. --- gv.c | 2 +- pp.c | 4 +++- t/op/coresubs.t | 7 +++++++ 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/gv.c b/gv.c index a9a1129..0bbf09e 100644 --- a/gv.c +++ b/gv.c @@ -1351,7 +1351,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne: case KEY_or: case KEY_x: case KEY_xor: return gv; - case KEY_bless: case KEY_caller: case KEY_chdir: + case KEY_caller: case KEY_chdir: case KEY_chmod: case KEY_chomp: case KEY_chop: case KEY_chown: case KEY_close: case KEY_dbmclose: case KEY_dbmopen: case KEY_die: diff --git a/pp.c b/pp.c index 302b5cc..04e4e4a 100644 --- a/pp.c +++ b/pp.c @@ -590,13 +590,15 @@ PP(pp_bless) HV *stash; if (MAXARG == 1) + curstash: stash = CopSTASH(PL_curcop); else { SV * const ssv = POPs; STRLEN len; const char *ptr; - if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv)) + if (!ssv) goto curstash; + if (!SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv)) Perl_croak(aTHX_ "Attempt to bless into a reference"); ptr = SvPV_const(ssv,len); if (len == 0) diff --git a/t/op/coresubs.t b/t/op/coresubs.t index 9573e1f..9a615fc 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -165,6 +165,13 @@ is &CORE::binmode(qw[foo bar]), undef, "&binmode"; lis [&CORE::binmode(qw[foo bar])], [undef], "&binmode in list context"; is &mybinmode(foo), undef, '&binmode with one arg'; +test_proto 'bless'; +$tests += 3; +like &CORE::bless([],'parcel'), qr/^parcel=ARRAY/, "&bless"; +like join(" ", &CORE::bless([],'parcel')), + qr/^parcel=ARRAY(?!.* )/, "&bless in list context"; +like &mybless([]), qr/^main=ARRAY/, '&bless with one arg'; + test_proto 'break'; { $tests ++; my $tmp; -- 2.7.4