t/op/each.t See if hash iterators work
t/op/eval.t See if eval operator works
t/op/exec.t See if exec and system work
+t/op/exists_sub.t See if exists(&sub) works
t/op/exp.t See if math functions work
t/op/fh.t See if filehandles work
t/op/filetest.t See if file tests work
switch (o->op_type) {
case OP_ENTERSUB:
- if ((type == OP_DEFINED || type == OP_LOCK) &&
+ if ((type == OP_EXISTS || type == OP_DEFINED || type == OP_LOCK) &&
!(o->op_flags & OPf_STACKED)) {
o->op_type = OP_RV2CV; /* entersub => rv2cv */
o->op_ppaddr = PL_ppaddr[OP_RV2CV];
o = ck_fun(o);
if (o->op_flags & OPf_KIDS) {
OP *kid = cUNOPo->op_first;
- if (kid->op_type == OP_AELEM)
+ if (kid->op_type == OP_ENTERSUB) {
+ (void) ref(kid, o->op_type);
+ if (kid->op_type != OP_RV2CV && !PL_error_count)
+ Perl_croak(aTHX_ "%s argument is not a subroutine name",
+ PL_op_desc[o->op_type]);
+ o->op_private |= OPpEXISTS_SUB;
+ }
+ else if (kid->op_type == OP_AELEM)
o->op_flags |= OPf_SPECIAL;
else if (kid->op_type != OP_HELEM)
Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
/* On flipflop, we saw ... instead of .. */
/* On UNOPs, saw bare parens, e.g. eof(). */
/* On OP_ENTERSUB || OP_NULL, saw a "do". */
+ /* On OP_EXISTS, treat av as av, not avhv. */
/* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
/* On OP_ENTERITER, loop var is per-thread */
/* On pushre, re is /\s+/ imp. by split " " */
/* Private for OP_DELETE */
#define OPpSLICE 64 /* Operating on a list of keys */
+/* Private for OP_EXISTS */
+#define OPpEXISTS_SUB 64 /* Checking for &sub, not {} or []. */
+
/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, OP_FTTEXT, OP_FTBINARY, */
/* string comparisons, and case changers. */
#define OPpLOCALE 64 /* Use locale */
C<$foo[10]->{'foo'}>. Note however, that the arrow is still
required for C<foo(10)->('bar')>.
+=head2 exists() is supported on subroutine names
+
+The exists() builtin now works on subroutine names. A subroutine
+is considered to exist if it has been declared (even if implicitly).
+See L<perlfunc/exists> for examples.
+
=head2 exists() and delete() are supported on array elements
The exists() and delete() builtins now work on simple arrays as well.
Verify operations that access pad objects (lexicals and temporaries).
+=item op/exists_sub
+
+Verify C<exists &sub> operations.
+
=back
=head1 Modules and Pragmata
if you are certain that you're calling the function correctly, you may put
an ampersand before the name to avoid the warning. See L<perlsub>.
+=item %s argument is not a subroutine name
+
+(F) The argument to exists() for C<exists &sub> must be a subroutine
+name, and not a subroutine call. C<exists &sub()> will generate this error.
+
=item %s package attribute may clash with future reserved word: %s
(W) A lowercase attribute name was used that had a package-specific handler.
@foo[$bar, $baz, $xyzzy]
@{$ref->[12]}{"susie", "queue"}
+=item %s argument is not a subroutine name
+
+(F) The argument to exists() for C<exists &sub> must be a subroutine
+name, and not a subroutine call. C<exists &sub()> will generate this error.
+
=item %s did not return a true value
(F) A required (or used) file must return a true value to indicate that
A hash or array element can be true only if it's defined, and defined if
it exists, but the reverse doesn't necessarily hold true.
+Given an expression that specifies the name of a subroutine,
+returns true if the specified subroutine has ever been declared, even
+if it is undefined. Mentioning a subroutine name for exists or defined
+does not count as declaring it.
+
+ print "Exists\n" if exists &subroutine;
+ print "Defined\n" if defined &subroutine;
+
Note that the EXPR can be arbitrarily complicated as long as the final
-operation is a hash or array key lookup:
+operation is a hash or array key lookup or subroutine name:
if (exists $ref->{A}->{B}->{$key}) { }
if (exists $hash{A}{B}{$key}) { }
if (exists $ref->{A}->{B}->[$ix]) { }
if (exists $hash{A}{B}[$ix]) { }
+ if (exists &{$ref->{A}{B}{$key}}) { }
+
Although the deepest nested array or hash will not spring into existence
just because its existence was tested, any intervening ones will.
Thus C<$ref-E<gt>{"A"}> and C<$ref-E<gt>{"A"}-E<gt>{"B"}> will spring
See L<perlref/"Pseudo-hashes"> for specifics on how exists() acts when
used on a pseudo-hash.
+Use of a subroutine call, rather than a subroutine name, as an argument
+to exists() is an error.
+
+ exists ⊂ # OK
+ exists &sub(); # Error
+
=item exit EXPR
Evaluates EXPR and exits immediately with that value. Example:
PP(pp_exists)
{
djSP;
- SV *tmpsv = POPs;
- HV *hv = (HV*)POPs;
+ SV *tmpsv;
+ HV *hv;
+
+ if (PL_op->op_private & OPpEXISTS_SUB) {
+ GV *gv;
+ CV *cv;
+ SV *sv = POPs;
+ cv = sv_2cv(sv, &hv, &gv, FALSE);
+ if (cv)
+ RETPUSHYES;
+ if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
+ RETPUSHYES;
+ RETPUSHNO;
+ }
+ tmpsv = POPs;
+ hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV) {
if (hv_exists_ent(hv, tmpsv, 0))
RETPUSHYES;
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
+print "1..9\n";
+
+sub t1;
+sub t2 : locked;
+sub t3 ();
+sub t4 ($);
+sub t5 {1;}
+{
+ package P1;
+ sub tmc {1;}
+ package P2;
+ @ISA = 'P1';
+}
+
+print "not " unless exists &t1 && not defined &t1;
+print "ok 1\n";
+print "not " unless exists &t2 && not defined &t2;
+print "ok 2\n";
+print "not " unless exists &t3 && not defined &t3;
+print "ok 3\n";
+print "not " unless exists &t4 && not defined &t4;
+print "ok 4\n";
+print "not " unless exists &t5 && defined &t5;
+print "ok 5\n";
+P2::->tmc;
+print "not " unless not exists &P2::tmc && not defined &P2::tmc;
+print "ok 6\n";
+my $ref;
+$ref->{A}[0] = \&t4;
+print "not " unless exists &{$ref->{A}[0]} && not defined &{$ref->{A}[0]};
+print "ok 7\n";
+undef &P1::tmc;
+print "not " unless exists &P1::tmc && not defined &P1::tmc;
+print "ok 8\n";
+eval 'exists &t5()';
+print "not " unless $@;
+print "ok 9\n";
+
+exit 0;