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 &&
#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 */
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? */
#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
opendir
or
ord
+our
pack
package
pipe
#include "EXTERN.h"
#define PERL_IN_OP_C
#include "perl.h"
+#include "keywords.h"
/* #define PL_OP_SLAB_ALLOC */
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 */
&& 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;
}
}
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 */
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);
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 */
}
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 &&
(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
#persistent.pl
use strict;
- use vars '%Cache';
+ our %Cache;
use Symbol qw(delete_package);
sub valid_package_name {
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
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;
# 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 = '';
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,
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;
# 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 = '';
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
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'>.
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
package Person;
use Carp;
- use vars qw($AUTOLOAD); # it's a package global
+ our $AUTOLOAD; # it's a package global
my %fields = (
name => undef,
package Employee;
use Person;
use strict;
- use vars qw(@ISA);
- @ISA = qw(Person);
+ our @ISA = qw(Person);
my %fields = (
id => undef,
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 }
}
use Alias qw(attr);
- use vars qw($NAME $AGE $PEERS);
+ our ($NAME, $AGE, $PEERS);
sub name {
my $self = attr shift;
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()
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;
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"
/* 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 */
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
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;
+ }
}
/*
}
#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] == '$' &&
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);
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);
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;
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{
# will want Carp.
print PM <<'END';
use Carp;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+our @EXPORT_OK;
END
}
}
# 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";
# 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
# 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);
projects / p5sagit/p5-mst-13.2.git / commitdiff