From: Larry Wall Date: Fri, 24 Sep 1999 21:59:37 +0000 (-0700) Subject: Re: [PATCH 5.005_61] "our" declarations X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77ca0c92d2c0e47301d906d355d9ab3afb6f6bcb;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH 5.005_61] "our" declarations Message-Id: <199909250459.VAA27506@kiev.wall.org> p4raw-id: //depot/perl@4227 --- diff --git a/gv.c b/gv.c index 29131ee..d257114 100644 --- a/gv.c +++ b/gv.c @@ -531,6 +531,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) else if ((COP*)PL_curcop == &PL_compiling) { stash = PL_curstash; if (add && (PL_hints & HINT_STRICT_VARS) && + !(add & GV_ADDOUR) && sv_type != SVt_PVCV && sv_type != SVt_PVGV && sv_type != SVt_PVFM && diff --git a/gv.h b/gv.h index a2b07bf..fc9985a 100644 --- a/gv.h +++ b/gv.h @@ -135,3 +135,4 @@ HV *GvHVn(); #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ +#define GV_ADDOUR 0x20 /* add "our" variable */ diff --git a/intrpvar.h b/intrpvar.h index e5b2691..a53d38b 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -295,7 +295,7 @@ PERLVAR(Ithisexpr, I32) /* name id for nothing_in_common() */ PERLVAR(Ilast_uni, char *) /* position of last named-unary op */ PERLVAR(Ilast_lop, char *) /* position of last list operator */ PERLVAR(Ilast_lop_op, OPCODE) /* last list operator */ -PERLVAR(Iin_my, bool) /* we're compiling a "my" declaration */ +PERLVAR(Iin_my, I32) /* we're compiling a "my" (or "our") declaration */ PERLVAR(Iin_my_stash, HV *) /* declared class of this "my" declaration */ #ifdef FCRYPT PERLVAR(Icryptseen, I32) /* has fast crypt() been initialized? */ diff --git a/keywords.h b/keywords.h index e818831..f6b98aa 100644 --- a/keywords.h +++ b/keywords.h @@ -140,111 +140,112 @@ #define KEY_opendir 139 #define KEY_or 140 #define KEY_ord 141 -#define KEY_pack 142 -#define KEY_package 143 -#define KEY_pipe 144 -#define KEY_pop 145 -#define KEY_pos 146 -#define KEY_print 147 -#define KEY_printf 148 -#define KEY_prototype 149 -#define KEY_push 150 -#define KEY_q 151 -#define KEY_qq 152 -#define KEY_qr 153 -#define KEY_quotemeta 154 -#define KEY_qw 155 -#define KEY_qx 156 -#define KEY_rand 157 -#define KEY_read 158 -#define KEY_readdir 159 -#define KEY_readline 160 -#define KEY_readlink 161 -#define KEY_readpipe 162 -#define KEY_recv 163 -#define KEY_redo 164 -#define KEY_ref 165 -#define KEY_rename 166 -#define KEY_require 167 -#define KEY_reset 168 -#define KEY_return 169 -#define KEY_reverse 170 -#define KEY_rewinddir 171 -#define KEY_rindex 172 -#define KEY_rmdir 173 -#define KEY_s 174 -#define KEY_scalar 175 -#define KEY_seek 176 -#define KEY_seekdir 177 -#define KEY_select 178 -#define KEY_semctl 179 -#define KEY_semget 180 -#define KEY_semop 181 -#define KEY_send 182 -#define KEY_setgrent 183 -#define KEY_sethostent 184 -#define KEY_setnetent 185 -#define KEY_setpgrp 186 -#define KEY_setpriority 187 -#define KEY_setprotoent 188 -#define KEY_setpwent 189 -#define KEY_setservent 190 -#define KEY_setsockopt 191 -#define KEY_shift 192 -#define KEY_shmctl 193 -#define KEY_shmget 194 -#define KEY_shmread 195 -#define KEY_shmwrite 196 -#define KEY_shutdown 197 -#define KEY_sin 198 -#define KEY_sleep 199 -#define KEY_socket 200 -#define KEY_socketpair 201 -#define KEY_sort 202 -#define KEY_splice 203 -#define KEY_split 204 -#define KEY_sprintf 205 -#define KEY_sqrt 206 -#define KEY_srand 207 -#define KEY_stat 208 -#define KEY_study 209 -#define KEY_sub 210 -#define KEY_substr 211 -#define KEY_symlink 212 -#define KEY_syscall 213 -#define KEY_sysopen 214 -#define KEY_sysread 215 -#define KEY_sysseek 216 -#define KEY_system 217 -#define KEY_syswrite 218 -#define KEY_tell 219 -#define KEY_telldir 220 -#define KEY_tie 221 -#define KEY_tied 222 -#define KEY_time 223 -#define KEY_times 224 -#define KEY_tr 225 -#define KEY_truncate 226 -#define KEY_uc 227 -#define KEY_ucfirst 228 -#define KEY_umask 229 -#define KEY_undef 230 -#define KEY_unless 231 -#define KEY_unlink 232 -#define KEY_unpack 233 -#define KEY_unshift 234 -#define KEY_untie 235 -#define KEY_until 236 -#define KEY_use 237 -#define KEY_utime 238 -#define KEY_values 239 -#define KEY_vec 240 -#define KEY_wait 241 -#define KEY_waitpid 242 -#define KEY_wantarray 243 -#define KEY_warn 244 -#define KEY_while 245 -#define KEY_write 246 -#define KEY_x 247 -#define KEY_xor 248 -#define KEY_y 249 +#define KEY_our 142 +#define KEY_pack 143 +#define KEY_package 144 +#define KEY_pipe 145 +#define KEY_pop 146 +#define KEY_pos 147 +#define KEY_print 148 +#define KEY_printf 149 +#define KEY_prototype 150 +#define KEY_push 151 +#define KEY_q 152 +#define KEY_qq 153 +#define KEY_qr 154 +#define KEY_quotemeta 155 +#define KEY_qw 156 +#define KEY_qx 157 +#define KEY_rand 158 +#define KEY_read 159 +#define KEY_readdir 160 +#define KEY_readline 161 +#define KEY_readlink 162 +#define KEY_readpipe 163 +#define KEY_recv 164 +#define KEY_redo 165 +#define KEY_ref 166 +#define KEY_rename 167 +#define KEY_require 168 +#define KEY_reset 169 +#define KEY_return 170 +#define KEY_reverse 171 +#define KEY_rewinddir 172 +#define KEY_rindex 173 +#define KEY_rmdir 174 +#define KEY_s 175 +#define KEY_scalar 176 +#define KEY_seek 177 +#define KEY_seekdir 178 +#define KEY_select 179 +#define KEY_semctl 180 +#define KEY_semget 181 +#define KEY_semop 182 +#define KEY_send 183 +#define KEY_setgrent 184 +#define KEY_sethostent 185 +#define KEY_setnetent 186 +#define KEY_setpgrp 187 +#define KEY_setpriority 188 +#define KEY_setprotoent 189 +#define KEY_setpwent 190 +#define KEY_setservent 191 +#define KEY_setsockopt 192 +#define KEY_shift 193 +#define KEY_shmctl 194 +#define KEY_shmget 195 +#define KEY_shmread 196 +#define KEY_shmwrite 197 +#define KEY_shutdown 198 +#define KEY_sin 199 +#define KEY_sleep 200 +#define KEY_socket 201 +#define KEY_socketpair 202 +#define KEY_sort 203 +#define KEY_splice 204 +#define KEY_split 205 +#define KEY_sprintf 206 +#define KEY_sqrt 207 +#define KEY_srand 208 +#define KEY_stat 209 +#define KEY_study 210 +#define KEY_sub 211 +#define KEY_substr 212 +#define KEY_symlink 213 +#define KEY_syscall 214 +#define KEY_sysopen 215 +#define KEY_sysread 216 +#define KEY_sysseek 217 +#define KEY_system 218 +#define KEY_syswrite 219 +#define KEY_tell 220 +#define KEY_telldir 221 +#define KEY_tie 222 +#define KEY_tied 223 +#define KEY_time 224 +#define KEY_times 225 +#define KEY_tr 226 +#define KEY_truncate 227 +#define KEY_uc 228 +#define KEY_ucfirst 229 +#define KEY_umask 230 +#define KEY_undef 231 +#define KEY_unless 232 +#define KEY_unlink 233 +#define KEY_unpack 234 +#define KEY_unshift 235 +#define KEY_untie 236 +#define KEY_until 237 +#define KEY_use 238 +#define KEY_utime 239 +#define KEY_values 240 +#define KEY_vec 241 +#define KEY_wait 242 +#define KEY_waitpid 243 +#define KEY_wantarray 244 +#define KEY_warn 245 +#define KEY_while 246 +#define KEY_write 247 +#define KEY_x 248 +#define KEY_xor 249 +#define KEY_y 250 diff --git a/keywords.pl b/keywords.pl index f907e3f..438849a 100755 --- a/keywords.pl +++ b/keywords.pl @@ -166,6 +166,7 @@ open opendir or ord +our pack package pipe diff --git a/op.c b/op.c index 788464f..8f8e796 100644 --- a/op.c +++ b/op.c @@ -18,6 +18,7 @@ #include "EXTERN.h" #define PERL_IN_OP_C #include "perl.h" +#include "keywords.h" /* #define PL_OP_SLAB_ALLOC */ @@ -111,9 +112,10 @@ Perl_pad_allocmy(pTHX_ char *name) SV *sv; if (!( + PL_in_my == KEY_our || isALPHA(name[1]) || (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) || - name[1] == '_' && (int)strlen(name) > 2)) + name[1] == '_' && (int)strlen(name) > 2 )) { if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) { /* 1999-02-27 mjd@plover.com */ @@ -145,8 +147,10 @@ Perl_pad_allocmy(pTHX_ char *name) && strEQ(name, SvPVX(sv))) { Perl_warner(aTHX_ WARN_UNSAFE, - "\"my\" variable %s masks earlier declaration in same %s", - name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); + "\"%s\" variable %s masks earlier declaration in same %s", + (PL_in_my == KEY_our ? "our" : "my"), + name, + (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); break; } } @@ -164,6 +168,8 @@ Perl_pad_allocmy(pTHX_ char *name) SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash); PL_sv_objcount++; } + if (PL_in_my == KEY_our) + SvFLAGS(sv) |= SVpad_OUR; av_store(PL_comppad_name, off, sv); SvNVX(sv) = (NV)PAD_MAX; SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ @@ -231,6 +237,8 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, SvNVX(namesv) = (NV)PL_curcop->cop_seq; SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */ SvFAKE_on(namesv); /* A ref, not a real var */ + if (SvFLAGS(sv) & SVpad_OUR)/* An "our" variable */ + SvFLAGS(namesv) |= SVpad_OUR; if (SvOBJECT(sv)) { /* A typed var */ SvOBJECT_on(namesv); (void)SvUPGRADE(namesv, SVt_PVMG); @@ -355,7 +363,7 @@ Perl_pad_findmy(pTHX_ char *name) seq > I_32(SvNVX(sv)))) && strEQ(SvPVX(sv), name)) { - if (SvIVX(sv)) + if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR) return (PADOFFSET)off; pendoff = off; /* this pending def. will override import */ } @@ -1731,6 +1739,10 @@ S_my_kid(pTHX_ OP *o, OP *attrs) my_kid(kid, attrs); } else if (type == OP_UNDEF) { return o; + } else if (type == OP_RV2SV || /* "our" declaration */ + type == OP_RV2AV || + type == OP_RV2HV) { /* XXX does this let anything illegal in? */ + return o; } else if (type != OP_PADSV && type != OP_PADAV && type != OP_PADHV && diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 551f059..ec41894 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1840,8 +1840,8 @@ have a name with which they can be found. (W) Typographical errors often show up as unique variable names. If you had a good reason for having a unique name, then just mention -it again somehow to suppress the message. The C pragma is -provided for just this purpose. +it again somehow to suppress the message. The C declaration is +provided for this purpose. =item Negative length diff --git a/pod/perlembed.pod b/pod/perlembed.pod index db5aab0..3ea1736 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -656,7 +656,7 @@ with L whenever possible. #persistent.pl use strict; - use vars '%Cache'; + our %Cache; use Symbol qw(delete_package); sub valid_package_name { diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod index d2e83be..26f7a69 100644 --- a/pod/perlfaq3.pod +++ b/pod/perlfaq3.pod @@ -53,7 +53,7 @@ Have you used C<-w>? It enables warnings for dubious practices. Have you tried C? It prevents you from using symbolic references, makes you predeclare any subroutines that you call as bare words, and (probably most importantly) forces you to predeclare your -variables with C or C. +variables with C or C or C. Did you check the returns of each and every system call? The operating system (and thus Perl) tells you whether they worked or not, and if not diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod index 070d965..72f4bb7 100644 --- a/pod/perlfaq7.pod +++ b/pod/perlfaq7.pod @@ -171,7 +171,7 @@ own module. Make sure to change the names appropriately. BEGIN { use Exporter (); - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); ## set the version for version checking; uncomment to use ## $VERSION = 1.00; @@ -188,10 +188,11 @@ own module. Make sure to change the names appropriately. # as well as any optionally exported functions @EXPORT_OK = qw($Var1 %Hashit); } - use vars @EXPORT_OK; + our @EXPORT_OK; # non-exported package globals go here - use vars qw( @more $stuff ); + our @more; + our $stuff; # initialize package globals, first exported ones $Var1 = ''; diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 237a38d..82c0521 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2700,6 +2700,18 @@ Returns the numeric (ASCII or Unicode) value of the first character of EXPR. If EXPR is omitted, uses C<$_>. For the reverse, see L. See L for more about Unicode. +=item our EXPR + +An C declares the listed variables to be valid globals within +the enclosing block, file, or C. That is, it has the same +scoping rules as a "my" declaration, but does not create a local +variable. If more than one value is listed, the list must be placed +in parentheses. The C declaration has no semantic effect unless +"use strict vars" is in effect, in which case it lets you use the +declared global variable without qualifying it with a package name. +(But only within the lexical scope of the C declaration. In this +it differs from "use vars", which is package scoped.) + =item pack TEMPLATE,LIST Takes a list of values and packs it into a binary structure, diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 0031d6e..fc81fdf 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -279,7 +279,7 @@ create a file called F and start with this template: BEGIN { use Exporter (); - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); # set the version for version checking $VERSION = 1.00; @@ -294,10 +294,11 @@ create a file called F and start with this template: # as well as any optionally exported functions @EXPORT_OK = qw($Var1 %Hashit &func3); } - use vars @EXPORT_OK; + our @EXPORT_OK; # non-exported package globals go here - use vars qw(@more $stuff); + our @more; + our $stuff; # initialize package globals, first exported ones $Var1 = ''; diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index bfc5223..99d31bd 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -36,7 +36,7 @@ which lasts until the end of that BLOCK. Some pragmas are lexically scoped--typically those that affect the C<$^H> hints variable. Others affect the current package instead, -like C and C, whic allow you to predeclare a +like C and C, which allow you to predeclare a variables or subroutines within a particular I rather than just a block. Such declarations are effective for the entire file for which they were declared. You cannot rescind them with C, or else must be fully qualified with the package name. +C or C, or else must be fully qualified with the package name. A compilation error results otherwise. An inner block may countermand this with C. diff --git a/pod/perltoot.pod b/pod/perltoot.pod index 89e5cbe..3062f59 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -1124,8 +1124,7 @@ it happens when you say If you wanted to add version checking to your Person class explained above, just add this to Person.pm: - use vars qw($VERSION); - $VERSION = '1.1'; + our $VERSION = '1.1'; and then in Employee.pm could you can say @@ -1363,7 +1362,7 @@ constructor will look like when taking this approach: package Person; use Carp; - use vars qw($AUTOLOAD); # it's a package global + our $AUTOLOAD; # it's a package global my %fields = ( name => undef, @@ -1433,8 +1432,7 @@ Here's how to be careful: package Employee; use Person; use strict; - use vars qw(@ISA); - @ISA = qw(Person); + our @ISA = qw(Person); my %fields = ( id => undef, @@ -1560,16 +1558,15 @@ Here's the whole implementation: BEGIN { use Exporter (); - use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS); - @EXPORT = qw(gethostbyname gethostbyaddr gethost); - @EXPORT_OK = qw( - $h_name @h_aliases - $h_addrtype $h_length - @h_addr_list $h_addr - ); - %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); + our @EXPORT = qw(gethostbyname gethostbyaddr gethost); + our @EXPORT_OK = qw( + $h_name @h_aliases + $h_addrtype $h_length + @h_addr_list $h_addr + ); + our %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } - use vars @EXPORT_OK; + our @EXPORT_OK; # Class::Struct forbids use of @ISA sub import { goto &Exporter::import } @@ -1661,7 +1658,7 @@ update value fields in the hash. Convenient, eh? } use Alias qw(attr); - use vars qw($NAME $AGE $PEERS); + our ($NAME, $AGE, $PEERS); sub name { my $self = attr shift; @@ -1692,7 +1689,7 @@ update value fields in the hash. Convenient, eh? return ++$AGE; } -The need for the C declaration is because what Alias does +The need for the C declaration is because what Alias does is play with package globals with the same name as the fields. To use globals while C is in effect, you have to predeclare them. These package variables are localized to the block enclosing the attr() diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 4200140..632f417 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -92,19 +92,18 @@ The file Mytest.pm should start with something like this: package Mytest; use strict; - use vars qw($VERSION @ISA @EXPORT); require Exporter; require DynaLoader; - @ISA = qw(Exporter DynaLoader); + our @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. - @EXPORT = qw( + our @EXPORT = qw( ); - $VERSION = '0.01'; + our $VERSION = '0.01'; bootstrap Mytest $VERSION; @@ -563,8 +562,7 @@ the following three lines: mylib/mylib.h To keep our namespace nice and unpolluted, edit the .pm file and change -the variable C<@EXPORT> to C<@EXPORT_OK> (there are two: one in the line -beginning "use vars" and one setting the array itself). Finally, in the +the variable C<@EXPORT> to C<@EXPORT_OK>. Finally, in the .xs file, edit the #include line to read: #include "mylib/mylib.h" diff --git a/sv.h b/sv.h index 1aab997..e99891d 100644 --- a/sv.h +++ b/sv.h @@ -153,6 +153,8 @@ struct io { /* Some private flags. */ +#define SVpad_OUR 0x80000000 /* pad name is "our" instead of "my" */ + #define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ #define SVpfm_COMPILED 0x80000000 /* FORMLINE is compiled */ diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars index 3e3e0e3..b8108d2 100644 --- a/t/pragma/strict-vars +++ b/t/pragma/strict-vars @@ -237,3 +237,73 @@ Global symbol "$x" requires explicit package name at (eval 1) line 1. ok 1 Global symbol "$x" requires explicit package name at (eval 2) line 1. ok 2 +######## + +# strict vars with outer our - no error +use strict 'vars' ; +our $freddy; +local $abc::joe ; +my $fred ; +my $b = \$fred ; +$Fred::ABC = 1 ; +$freddy = 2 ; +EXPECT + +######## + +# strict vars with inner our - no error +use strict 'vars' ; +sub foo { + our $fred; + $fred; +} +EXPECT + +######## + +# strict vars with outer our, inner use - no error +use strict 'vars' ; +our $fred; +sub foo { + $fred; +} +EXPECT + +######## + +# strict vars with nested our - no error +use strict 'vars' ; +our $fred; +sub foo { + our $fred; + $fred; +} +$fred ; +EXPECT + +######## + +# strict vars with elapsed our - error +use strict 'vars' ; +sub foo { + our $fred; + $fred; +} +$fred ; +EXPECT +Variable "$fred" is not imported at - line 8. +Global symbol "$fred" requires explicit package name at - line 8. +Execution of - aborted due to compilation errors. +######## + +# nested our with local - no error +$fred = 1; +use strict 'vars'; +{ + local our $fred = 2; + print $fred,"\n"; +} +print our $fred,"\n"; +EXPECT +2 +1 diff --git a/toke.c b/toke.c index 1691542..8777426 100644 --- a/toke.c +++ b/toke.c @@ -1971,12 +1971,17 @@ Perl_yylex(pTHX) if it's a legal name, the OP is a PADANY. */ if (PL_in_my) { - if (strchr(PL_tokenbuf,':')) - yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf)); + if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */ + tmp = pad_allocmy(PL_tokenbuf); + } + else { + if (strchr(PL_tokenbuf,':')) + yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf)); - yylval.opval = newOP(OP_PADANY, 0); - yylval.opval->op_targ = pad_allocmy(PL_tokenbuf); - return PRIVATEREF; + yylval.opval = newOP(OP_PADANY, 0); + yylval.opval->op_targ = pad_allocmy(PL_tokenbuf); + return PRIVATEREF; + } } /* @@ -2004,6 +2009,22 @@ Perl_yylex(pTHX) } #endif /* USE_THREADS */ if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) { + /* might be an "our" variable" */ + if (SvFLAGS(AvARRAY(PL_comppad_name)[tmp]) & SVpad_OUR) { + /* build ops for a bareword */ + yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0)); + yylval.opval->op_private = OPpCONST_ENTERED; + gv_fetchpv(PL_tokenbuf+1, + (PL_in_eval + ? (GV_ADDMULTI | GV_ADDINEVAL | GV_ADDOUR) + : GV_ADDOUR + ), + ((PL_tokenbuf[0] == '$') ? SVt_PV + : (PL_tokenbuf[0] == '@') ? SVt_PVAV + : SVt_PVHV)); + return WORD; + } + /* if it's a sort block and they're naming $a or $b */ if (PL_last_lop_op == OP_SORT && PL_tokenbuf[0] == '$' && @@ -3959,8 +3980,16 @@ Perl_yylex(pTHX) if ((PL_bufend - p) >= 3 && strnEQ(p, "my", 2) && isSPACE(*(p + 2))) p += 2; + else if ((PL_bufend - p) >= 4 && + strnEQ(p, "our", 3) && isSPACE(*(p + 3))) + p += 3; p = skipspace(p); - if (isIDFIRST_lazy(p)) + if (isIDFIRST_lazy(p)) { + p = scan_ident(p, PL_bufend, + PL_tokenbuf, sizeof PL_tokenbuf, TRUE); + p = skipspace(p); + } + if (*p != '$') Perl_croak(aTHX_ "Missing $ on loop variable"); } OPERATOR(FOR); @@ -4166,8 +4195,9 @@ Perl_yylex(pTHX) case KEY_msgsnd: LOP(OP_MSGSND,XTERM); + case KEY_our: case KEY_my: - PL_in_my = TRUE; + PL_in_my = tmp; s = skipspace(s); if (isIDFIRST_lazy(s)) { s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); @@ -5120,8 +5150,7 @@ Perl_keyword(pTHX_ register char *d, I32 len) case 3: if (strEQ(d,"ord")) return -KEY_ord; if (strEQ(d,"oct")) return -KEY_oct; - if (strEQ(d,"our")) { deprecate("reserved word \"our\""); - return 0;} + if (strEQ(d,"our")) return KEY_our; break; case 4: if (strEQ(d,"open")) return -KEY_open; diff --git a/utils/h2xs.PL b/utils/h2xs.PL index bd0ba16..ae266de 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -417,7 +417,7 @@ END if( $opt_X || $opt_c || $opt_A ){ # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD print PM <<'END'; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +our @EXPORT_OK; END } else{ @@ -425,7 +425,7 @@ else{ # will want Carp. print PM <<'END'; use Carp; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); +our @EXPORT_OK; END } @@ -450,7 +450,7 @@ unless ($opt_A) { # no autoloader whatsoever. } # Determine @ISA. -my $myISA = '@ISA = qw(Exporter'; # We seem to always want this. +my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this. $myISA .= ' DynaLoader' unless $opt_X; # no XS $myISA .= ');'; print PM "\n$myISA\n\n"; @@ -459,10 +459,10 @@ print PM<<"END"; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. -\@EXPORT = qw( +our \@EXPORT = qw( @const_names ); -\$VERSION = '$TEMPLATE_VERSION'; +our \$VERSION = '$TEMPLATE_VERSION'; END @@ -473,6 +473,7 @@ sub AUTOLOAD { # to the AUTOLOAD in AutoLoader. my \$constname; + our $AUTOLOAD; (\$constname = \$AUTOLOAD) =~ s/.*:://; croak "&$module::constant not defined" if \$constname eq 'constant'; my \$val = constant(\$constname, \@_ ? \$_[0] : 0);