summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/B/Deparse.pm2
-rw-r--r--lib/B/Op_private.pm12
-rw-r--r--lib/builtin.t6
-rw-r--r--op.c5
-rw-r--r--opcode.h10
-rw-r--r--pp.c32
-rw-r--r--regen/op_private2
-rw-r--r--regen/opcodes2
8 files changed, 48 insertions, 23 deletions
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index eb4e1827fc..3739993f8e 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -6615,7 +6615,7 @@ sub pp_isbool { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "isbool"); }
sub pp_isweak { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "isweak"); }
sub pp_weaken { builtin1(@_, "weaken"); }
sub pp_unweaken { builtin1(@_, "unweaken"); }
-sub pp_blessed { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "blessed"); }
+sub pp_blessed { builtin1(@_, "blessed"); }
sub pp_refaddr { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "refaddr"); }
sub pp_reftype { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "reftype"); }
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index b2faef915d..583f6cd0b7 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -138,7 +138,7 @@ $bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter en
$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr values vec);
-$bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv ref rv2hv);
+$bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(blessed padhv ref rv2hv);
$bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray);
$bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open);
$bits{$_}{4} = 'OPpOPEN_IN_RAW' for qw(backtick open);
@@ -149,7 +149,7 @@ $bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark re
$bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
$bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite);
$bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv);
-$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 blessed chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
+$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
$bits{$_}{0} = 'OPpTRANS_CAN_FORCE_UTF8' for qw(trans transr);
$bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr);
$bits{$_}{7} = 'OPpTRANS_DELETE' for qw(trans transr);
@@ -157,7 +157,7 @@ $bits{$_}{6} = 'OPpTRANS_GROWS' for qw(trans transr);
$bits{$_}{2} = 'OPpTRANS_IDENTICAL' for qw(trans transr);
$bits{$_}{3} = 'OPpTRANS_SQUASH' for qw(trans transr);
$bits{$_}{1} = 'OPpTRANS_USE_SVOP' for qw(trans transr);
-$bits{$_}{5} = 'OPpTRUEBOOL' for qw(grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst);
+$bits{$_}{5} = 'OPpTRUEBOOL' for qw(blessed grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst);
$bits{$_}{2} = 'OPpUSEINT' for qw(bit_and bit_or bit_xor complement left_shift nbit_and nbit_or nbit_xor ncomplement right_shift sbit_and sbit_or sbit_xor);
my @bf = (
@@ -827,7 +827,7 @@ our %ops_using = (
OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multiconcat multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv split)],
OPpLVREF_ELEM => [qw(lvref refassign)],
OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr values vec)],
- OPpMAYBE_TRUEBOOL => [qw(padhv ref rv2hv)],
+ OPpMAYBE_TRUEBOOL => [qw(blessed padhv ref rv2hv)],
OPpMULTICONCAT_APPEND => [qw(multiconcat)],
OPpMULTIDEREF_DELETE => [qw(multideref)],
OPpOFFBYONE => [qw(caller runcv wantarray)],
@@ -844,9 +844,9 @@ our %ops_using = (
OPpSORT_DESCEND => [qw(sort)],
OPpSPLIT_ASSIGN => [qw(split)],
OPpSUBSTR_REPL_FIRST => [qw(substr)],
- OPpTARGET_MY => [qw(abs add atan2 blessed chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
+ OPpTARGET_MY => [qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
OPpTRANS_CAN_FORCE_UTF8 => [qw(trans transr)],
- OPpTRUEBOOL => [qw(grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
+ OPpTRUEBOOL => [qw(blessed grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
OPpUSEINT => [qw(bit_and bit_or bit_xor complement left_shift nbit_and nbit_or nbit_xor ncomplement right_shift sbit_and sbit_or sbit_xor)],
);
diff --git a/lib/builtin.t b/lib/builtin.t
index dec6b9eae2..e35e8ab393 100644
--- a/lib/builtin.t
+++ b/lib/builtin.t
@@ -85,6 +85,12 @@ package FetchStoreCounter {
is(blessed($arr), undef, 'blessed yields undef for non-object');
is(blessed($obj), "Object", 'blessed yields package name for object');
+
+ # blessed() as a boolean
+ is(blessed($obj) ? "YES" : "NO", "YES", 'blessed in boolean context still works');
+
+ # blessed() appears false as a boolean on package "0"
+ is(blessed(bless [], "0") ? "YES" : "NO", "NO", 'blessed in boolean context handles "0" cornercase');
}
# imports are lexical; should not be visible here
diff --git a/op.c b/op.c
index abf1a81031..3c119c2133 100644
--- a/op.c
+++ b/op.c
@@ -18263,7 +18263,10 @@ Perl_rpeep(pTHX_ OP *o)
}
case OP_REF:
- /* see if ref() is used in boolean context */
+ case OP_BLESSED:
+ /* if the op is used in boolean context, set the TRUEBOOL flag
+ * which enables an optimisation at runtime which avoids creating
+ * a stack temporary for known-true package names */
if ((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR)
S_check_for_bool_cxt(o, 1, OPpTRUEBOOL, OPpMAYBE_TRUEBOOL);
break;
diff --git a/opcode.h b/opcode.h
index 9ea8ef142e..0d064864b2 100644
--- a/opcode.h
+++ b/opcode.h
@@ -2240,7 +2240,7 @@ EXTCONST U32 PL_opargs[] = {
0x0000011e, /* isweak */
0x00000100, /* weaken */
0x00000100, /* unweaken */
- 0x0000011e, /* blessed */
+ 0x00000106, /* blessed */
0x0000011e, /* refaddr */
0x0000011e, /* reftype */
};
@@ -2917,7 +2917,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
75, /* isweak */
0, /* weaken */
0, /* unweaken */
- 75, /* blessed */
+ 49, /* blessed */
75, /* refaddr */
75, /* reftype */
@@ -2952,14 +2952,14 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2fdc, 0x3658, 0x03d6, 0x4184, 0x0003, /* rv2sv */
0x30cc, 0x0003, /* av2arylen, akeys, values, keys */
0x339c, 0x1078, 0x0dd4, 0x014c, 0x4488, 0x4184, 0x0003, /* rv2cv */
- 0x05b4, 0x0650, 0x0003, /* ref */
+ 0x05b4, 0x0650, 0x0003, /* ref, blessed */
0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
0x383c, 0x3758, 0x2894, 0x27d0, 0x0003, /* backtick */
0x05b5, /* subst */
0x117c, 0x21b8, 0x09b4, 0x3fec, 0x2548, 0x4764, 0x07c1, /* trans, transr */
0x0fbc, 0x04d8, 0x0067, /* sassign */
0x0c78, 0x0b74, 0x0a70, 0x30cc, 0x05a8, 0x0067, /* aassign */
- 0x4530, 0x0003, /* chomp, schomp, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir, isbool, isweak, blessed, refaddr, reftype */
+ 0x4530, 0x0003, /* chomp, schomp, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir, isbool, isweak, refaddr, reftype */
0x05b4, 0x30cc, 0x0003, /* pos */
0x4530, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */
0x1538, 0x0067, /* repeat */
@@ -3427,7 +3427,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* ISWEAK */ (OPpARG1_MASK|OPpTARGET_MY),
/* WEAKEN */ (OPpARG1_MASK),
/* UNWEAKEN */ (OPpARG1_MASK),
- /* BLESSED */ (OPpARG1_MASK|OPpTARGET_MY),
+ /* BLESSED */ (OPpARG1_MASK|OPpMAYBE_TRUEBOOL|OPpTRUEBOOL),
/* REFADDR */ (OPpARG1_MASK|OPpTARGET_MY),
/* REFTYPE */ (OPpARG1_MASK|OPpTARGET_MY),
diff --git a/pp.c b/pp.c
index 79b73e45a1..8376168354 100644
--- a/pp.c
+++ b/pp.c
@@ -7256,20 +7256,36 @@ PP(pp_unweaken)
PP(pp_blessed)
{
dSP;
- dTARGET;
- SV *arg = POPs;
+ SV *arg = TOPs;
SV *rv;
SvGETMAGIC(arg);
- if(SvROK(arg) && SvOBJECT((rv = SvRV(arg)))) {
- sv_ref(TARG, rv, TRUE);
- SvSETMAGIC(TARG);
+ if(!SvROK(arg) || !SvOBJECT((rv = SvRV(arg)))) {
+ SETs(&PL_sv_undef);
+ RETURN;
+ }
+
+ if((PL_op->op_private & OPpTRUEBOOL) ||
+ ((PL_op->op_private & OPpMAYBE_TRUEBOOL) && (block_gimme() == G_VOID))) {
+ /* We only care about the boolean truth, not the specific string value.
+ * We just have to check for the annoying cornercase of the package
+ * named "0" */
+ HV *stash = SvSTASH(rv);
+ HEK *hek = HvNAME_HEK(stash);
+ if(!hek)
+ goto fallback;
+ I32 len = HEK_LEN(hek);
+ if(UNLIKELY(len == HEf_SVKEY || (len == 1 && HEK_KEY(hek)[0] == '0')))
+ goto fallback;
+
+ SETs(&PL_sv_yes);
+ }
+ else {
+fallback:
+ SETs(sv_ref(NULL, rv, TRUE));
}
- else
- sv_setsv(TARG, &PL_sv_undef);
- PUSHs(TARG);
RETURN;
}
diff --git a/regen/op_private b/regen/op_private
index 357b4a1a32..0dc0b616c9 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -456,7 +456,7 @@ addbits($_, 3 => qw(OPpMAYBE_LVSUB LVSUB))
-for (qw(rv2hv padhv ref)) {
+for (qw(rv2hv padhv ref blessed)) {
addbits($_, # e.g. %hash in (%hash || $foo) ...
4 => qw(OPpMAYBE_TRUEBOOL BOOL?), # but cx not known till run time
5 => qw(OPpTRUEBOOL BOOL),
diff --git a/regen/opcodes b/regen/opcodes
index 176ca352c4..ade3d70acc 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -588,6 +588,6 @@ isbool boolean type test ck_null fsT1
isweak weakref type test ck_null fsT1
weaken reference weaken ck_null 1
unweaken reference unweaken ck_null 1
-blessed blessed ck_null fsT1
+blessed blessed ck_null fs1
refaddr refaddr ck_null fsT1
reftype reftype ck_null fsT1
View Lorry Controller Status