diff options
-rw-r--r-- | gv.c | 1 | ||||
-rw-r--r-- | gv.h | 1 | ||||
-rw-r--r-- | intrpvar.h | 2 | ||||
-rw-r--r-- | keywords.h | 217 | ||||
-rwxr-xr-x | keywords.pl | 1 | ||||
-rw-r--r-- | op.c | 20 | ||||
-rw-r--r-- | pod/perldiag.pod | 4 | ||||
-rw-r--r-- | pod/perlembed.pod | 2 | ||||
-rw-r--r-- | pod/perlfaq3.pod | 2 | ||||
-rw-r--r-- | pod/perlfaq7.pod | 7 | ||||
-rw-r--r-- | pod/perlfunc.pod | 12 | ||||
-rw-r--r-- | pod/perlmod.pod | 7 | ||||
-rw-r--r-- | pod/perlmodlib.pod | 2 | ||||
-rw-r--r-- | pod/perlsub.pod | 2 | ||||
-rw-r--r-- | pod/perltoot.pod | 29 | ||||
-rw-r--r-- | pod/perlxstut.pod | 10 | ||||
-rw-r--r-- | sv.h | 2 | ||||
-rw-r--r-- | t/pragma/strict-vars | 70 | ||||
-rw-r--r-- | toke.c | 47 | ||||
-rw-r--r-- | utils/h2xs.PL | 11 |
20 files changed, 288 insertions, 161 deletions
@@ -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 && @@ -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 e5b26913e8..a53d38b325 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 e818831148..f6b98aa802 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 f907e3f115..438849a057 100755 --- a/keywords.pl +++ b/keywords.pl @@ -166,6 +166,7 @@ open opendir or ord +our pack package pipe @@ -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 551f0590aa..ec41894048 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<use vars> pragma is -provided for just this purpose. +it again somehow to suppress the message. The C<our> declaration is +provided for this purpose. =item Negative length diff --git a/pod/perlembed.pod b/pod/perlembed.pod index db5aab0052..3ea173688f 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -656,7 +656,7 @@ with L<perlfunc/my> 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 d2e83be460..26f7a693f3 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<use strict>? 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<my> or C<use vars>. +variables with C<my> or C<our> or C<use vars>. 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 070d9653d4..72f4bb74ab 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 237a38ddf8..82c052148b 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</chr>. See L<utf8> for more about Unicode. +=item our EXPR + +An C<our> declares the listed variables to be valid globals within +the enclosing block, file, or C<eval>. 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<our> 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<our> 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 0031d6e0e6..fc81fdfaae 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -279,7 +279,7 @@ create a file called F<Some/Module.pm> 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<Some/Module.pm> 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 bfc5223819..99d31bd6e1 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<use vars> and C<use subs>, whic allow you to predeclare a +like C<use vars> and C<use subs>, which allow you to predeclare a variables or subroutines within a particular I<file> rather than just a block. Such declarations are effective for the entire file for which they were declared. You cannot rescind them with C<no diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 2beb3dea55..4abdc39529 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -353,7 +353,7 @@ which are always global, if you say then any variable mentioned from there to the end of the enclosing block must either refer to a lexical variable, be predeclared via -C<use vars>, or else must be fully qualified with the package name. +C<our> or C<use vars>, or else must be fully qualified with the package name. A compilation error results otherwise. An inner block may countermand this with C<no strict 'vars'>. diff --git a/pod/perltoot.pod b/pod/perltoot.pod index 89e5cbe993..3062f5924d 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<use vars> declaration is because what Alias does +The need for the C<our> declaration is because what Alias does is play with package globals with the same name as the fields. To use globals while C<use strict> 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 4200140833..632f417496 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" @@ -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 3e3e0e3a35..b8108d278c 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 @@ -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 bd0ba16f46..ae266de3cb 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); |