Change 23256 by davem@no-spam on 2004/09/01 23:41:25
Subject: [PATCH] fields.pm lost compile-time benefit
From: Rick Delaney <rick@no-spam>
Date: Fri, 13 Aug 2004 19:54:12 -0400
Message-Id: <20040813235412.GB12980@no-spam>
restore the compile-time field checking for
my Dog $spot; $spot->{'walkies'};
that was lost when pseudo-hashes were removed
Affected files ...
... //depot/perl/lib/base/t/fields-base.t#3 edit
... //depot/perl/lib/base/t/fields.t#4 edit
... //depot/perl/op.c#638 edit
... //depot/perl/pod/perldiag.pod#389 edit
Differences ...
==== //depot/perl/lib/base/t/fields-base.t#3 (text) ====
Index: perl/lib/base/t/fields-base.t
--- perl/lib/base/t/fields-base.t#2~22208~ Sat Jan 24 08:13:17 2004
+++ perl/lib/base/t/fields-base.t Wed Sep 1 16:41:25 2004
@@no-spam -1,8 +1,9 @@no-spam
#!/usr/bin/perl -w
-my $Has_PH;
+my ($Has_PH, $Field);
BEGIN {
$Has_PH = $] < 5.009;
+ $Field = $Has_PH ? "pseudo-hash field" : "class field";
}
my $W;
@@no-spam -20,7 +21,7 @@no-spam
}
use strict;
-use Test::More tests => 26;
+use Test::More tests => 28;
BEGIN { use_ok('base'); }
@@no-spam -156,17 +157,22 @@no-spam
$obj2->{b1} = "D3";
# We should get compile time failures field name typos
-eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
-if( $Has_PH ) {
- like $@no-spam
- qr/^No such pseudo-hash field "notthere" in variable \$obj3 of type D3/;
-}
-else {
- like $@no-spam
- qr/^Attempt to access disallowed key 'notthere' in a restricted hash/;
-}
+eval q(return; my D3 $obj3 = $obj2; $obj3->{notthere} = "");
+like $@no-spam
+ qr/^No such $Field "notthere" in variable \$obj3 of type D3/,
+ "Compile failure of undeclared fields (helem)";
# Slices
+# We should get compile time failures field name typos
+eval q(return; my D3 $obj3 = $obj2; my $k; @no-spam = ());
+like $@no-spam
+ qr/^No such $Field "notthere" in variable \$obj3 of type D3/,
+ "Compile failure of undeclared fields (hslice)";
+eval q(return; my D3 $obj3 = $obj2; my $k; @no-spam = ());
+like
+ $@no-spam qr/^No such $Field "notthere" in variable \$obj3 of type D3/,
+ "Compile failure of undeclared fields (hslice (block form))";
+
@no-spam"_b1", "b1"} = (17, 29);
is( $obj1->{_b1}, 17 );
is( $obj1->{b1}, 29 );
==== //depot/perl/lib/base/t/fields.t#4 (text) ====
Index: perl/lib/base/t/fields.t
--- perl/lib/base/t/fields.t#3~21235~ Mon Sep 15 21:35:34 2003
+++ perl/lib/base/t/fields.t Wed Sep 1 16:41:25 2004
@@no-spam -39,12 +39,12 @@no-spam
[sort qw(_no _up_yours)]);
# We should get compile time failures field name typos
-eval q(my Foo $obj = Foo->new; $obj->{notthere} = "");
+eval q(return; my Foo $obj = Foo->new; $obj->{notthere} = "");
my $error = $Has_PH ? 'No such(?: [\w-]+)? field "notthere"'
- : q[Attempt to access disallowed key 'notthere' in a ].
- q[restricted hash at ];
-ok( $@no-spam && $@no-spam =~ /^$error/i );
+ : q[No such class field "notthere" in variable $obj ].
+ q[of type Foo];
+ok( $@no-spam && $@no-spam =~ /^\Q$error/i );
foreach (Foo->new) {
==== //depot/perl/op.c#638 (text) ====
Index: perl/op.c
--- perl/op.c#637~23176~ Sat Jul 31 09:21:50 2004
+++ perl/op.c Wed Sep 1 16:41:25 2004
@@no-spam -6600,7 +6600,9 @@no-spam
break;
case OP_HELEM: {
+ UNOP *rop;
SV *lexname;
+ GV **fields;
SV **svp, *sv;
char *key = NULL;
STRLEN keylen;
@@no-spam -6620,8 +6622,87 @@no-spam
SvREFCNT_dec(sv);
*svp = lexname;
}
+
+ if ((o->op_private & (OPpLVAL_INTRO)))
+ break;
+
+ rop = (UNOP*)((BINOP*)o)->op_first;
+ if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
+ break;
+ lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
+ if (!(SvFLAGS(lexname) & SVpad_TYPED))
+ break;
+ fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+ if (!fields || !GvHV(*fields))
+ break;
+ key = SvPV(*svp, keylen);
+ if (!hv_fetch(GvHV(*fields), key,
+ SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
+ {
+ Perl_croak(aTHX_ "No such class field \"%s\" "
+ "in variable %s of type %s",
+ key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+ }
+
break;
}
+
+ case OP_HSLICE: {
+ UNOP *rop;
+ SV *lexname;
+ GV **fields;
+ SV **svp;
+ char *key;
+ STRLEN keylen;
+ SVOP *first_key_op, *key_op;
+
+ if ((o->op_private & (OPpLVAL_INTRO))
+ /* I bet there's always a pushmark... */
+ || ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST)
+ /* hmmm, no optimization if list contains only one key. */
+ break;
+ rop = (UNOP*)((LISTOP*)o)->op_last;
+ if (rop->op_type != OP_RV2HV)
+ break;
+ if (rop->op_first->op_type == OP_PADSV)
+ /* @no-spam here)} */
+ rop = (UNOP*)rop->op_first;
+ else {
+ /* @no-spam here)} */
+ if (rop->op_first->op_type == OP_SCOPE
+ && cLISTOPx(rop->op_first)->op_last->op_type == OP_PADSV)
+ {
+ rop = (UNOP*)cLISTOPx(rop->op_first)->op_last;
+ }
+ else
+ break;
+ }
+
+ lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE);
+ if (!(SvFLAGS(lexname) & SVpad_TYPED))
+ break;
+ fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+ if (!fields || !GvHV(*fields))
+ break;
+ /* Again guessing that the pushmark can be jumped over.... */
+ first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling)
+ ->op_first->op_sibling;
+ for (key_op = first_key_op; key_op;
+ key_op = (SVOP*)key_op->op_sibling) {
+ if (key_op->op_type != OP_CONST)
+ continue;
+ svp = cSVOPx_svp(key_op);
+ key = SvPV(*svp, keylen);
+ if (!hv_fetch(GvHV(*fields), key,
+ SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
+ {
+ Perl_croak(aTHX_ "No such class field \"%s\" "
+ "in variable %s of type %s",
+ key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+ }
+ }
+ break;
+ }
case OP_SORT: {
/* will point to RV2AV or PADAV op on LHS/RHS of assign */
==== //depot/perl/pod/perldiag.pod#389 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#388~23192~ Tue Aug 3 23:55:46 2004
+++ perl/pod/perldiag.pod Wed Sep 1 16:41:25 2004
@@no-spam -2449,6 +2449,12 @@no-spam
(F) The indicated command line switch needs a mandatory argument, but
you haven't specified one.
+=item No such class field "%s" in variable %s of type %s
+
+(F) You tried to access a key from a hash through the indicated typed variable
+but that key is not allowed by the package of the same type. The indicated
+package has restricted the set of allowed keys using the L<fields> pragma.
+
=item No such class %s
(F) You provided a class qualifier in a "my" or "our" declaration, but
End of Patch.