[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
Re: exists &sub (was: exists $foo[7] and delete $foo[7])
On Tue, 18 Jan 2000 17:27:59 -0800 (PST), Larry Wall wrote (in part):
law> You might argue that you could always use *foo{CODE} for the
law> same thing, but the *foo{CODE} slot can potentially be used
law> for caching methods too, so it means something slightly
law> different.
Er, no. *foo{CODE} uses GvCVu() internally, so it doesn't expose the
method cache. However, since what you wrote implies that you expect
exists &sub not to expose it either, this patch doesn't.
>> If so, should it be for 5.6?
law> It's kinda nice, it doesn't break anything, it increases
law> orthogonality if you squint at it right, and it might even
law> be useful. And, as you say, there's a patch. Other than
law> that, no reason at all. :-)
Fine. Patch below, relative to a patched-up perl (after
mirroring Sarathy's APC/diffs directory).
Sarathy, files modified are:
./pod/perlfunc.pod
./pod/perldelta.pod
./pod/perldiag.pod
./pp.c
./op.c
./op.h
./MANIFEST
One new file:
./t/op/exists_sub.t
/spider
Applies with `[g]patch -p1 -N'.
--- ./pod/perlfunc.pod.GSAR Tue Jan 18 23:16:46 2000
+++ ./pod/perlfunc.pod Wed Jan 19 00:53:51 2000
@@ -1422,8 +1422,16 @@ element is not autovivified if it doesn'
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 of 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}) { }
@@ -1431,6 +1439,8 @@ operation is a hash or array key lookup:
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
@@ -1447,6 +1457,12 @@ release.
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
--- ./pod/perldelta.pod.GSAR Sat Jan 15 19:52:02 2000
+++ ./pod/perldelta.pod Wed Jan 19 00:51:41 2000
@@ -425,6 +425,12 @@ This is rather similar to how the arrow
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.
@@ -1114,6 +1120,10 @@ File test operators.
Verify operations that access pad objects (lexicals and temporaries).
+=item op/exists_sub
+
+Verify C<exists &sub> operations.
+
=back
=head1 Modules and Pragmata
@@ -1591,6 +1601,11 @@ declaration for the subroutine in questi
definition ahead of the call to get proper prototype checking. Alternatively,
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
--- ./pod/perldiag.pod.GSAR Sat Jan 15 19:52:02 2000
+++ ./pod/perldiag.pod Wed Jan 19 00:48:44 2000
@@ -159,6 +159,11 @@ or a hash or array slice, such as:
@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
--- ./t/op/exists_sub.t.GSAR Wed Jan 19 00:16:46 2000
+++ ./t/op/exists_sub.t Wed Jan 19 01:28:31 2000
@@ -0,0 +1,46 @@
+#!./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;
--- ./pp.c.GSAR Sat Jan 15 19:51:58 2000
+++ ./pp.c Tue Jan 18 23:23:25 2000
@@ -2701,8 +2701,22 @@ PP(pp_delete)
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;
--- ./op.c.GSAR Sat Jan 15 19:51:56 2000
+++ ./op.c Tue Jan 18 23:22:16 2000
@@ -1691,7 +1691,7 @@ Perl_ref(pTHX_ OP *o, I32 type)
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];
@@ -5033,7 +5033,14 @@ Perl_ck_exists(pTHX_ OP *o)
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)
+ 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",
--- ./op.h.GSAR Sat Jan 15 18:02:03 2000
+++ ./op.h Tue Jan 18 23:20:08 2000
@@ -77,6 +77,7 @@ typedef U32 PADOFFSET;
/* 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 " " */
@@ -159,6 +160,9 @@ typedef U32 PADOFFSET;
/* 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. */
--- ./MANIFEST.GSAR Tue Jan 18 23:16:42 2000
+++ ./MANIFEST Wed Jan 19 00:17:58 2000
@@ -1311,6 +1311,7 @@ t/op/do.t See if subroutines work
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
- Follow-Ups from:
-
Gurusamy Sarathy <gsar@ActiveState.com>
Ronald J Kimball <rjk@linguist.dartmouth.edu>
- References to:
-
Larry Wall <larry@wall.org>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]