This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate cfgperl contents into mainline
authorGurusamy Sarathy <gsar@cpan.org>
Sat, 25 Sep 1999 07:03:34 +0000 (07:03 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Sat, 25 Sep 1999 07:03:34 +0000 (07:03 +0000)
p4raw-id: //depot/perl@4228

24 files changed:
gv.c
gv.h
intrpvar.h
keywords.h
keywords.pl
op.c
perlapi.c [changed mode: 0755->0644]
perlapi.h [changed mode: 0755->0644]
pod/perldiag.pod
pod/perlembed.pod
pod/perlfaq3.pod
pod/perlfaq7.pod
pod/perlfunc.pod
pod/perlmod.pod
pod/perlmodlib.pod
pod/perlsub.pod
pod/perltoot.pod
pod/perlxstut.pod
sv.h
t/op/filetest.t [changed mode: 0644->0755]
t/op/subst_amp.t [changed mode: 0644->0755]
t/pragma/strict-vars
toke.c
utils/h2xs.PL

diff --git a/gv.c b/gv.c
index 29131ee..d257114 100644 (file)
--- 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 (file)
--- 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 */
index e5b2691..a53d38b 100644 (file)
@@ -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? */
index e818831..f6b98aa 100644 (file)
 #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
index f907e3f..438849a 100755 (executable)
@@ -166,6 +166,7 @@ open
 opendir
 or
 ord
+our
 pack
 package
 pipe
diff --git a/op.c b/op.c
index 788464f..8f8e796 100644 (file)
--- 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 &&
old mode 100755 (executable)
new mode 100644 (file)
old mode 100755 (executable)
new mode 100644 (file)
index 551f059..ec41894 100644 (file)
@@ -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
 
index db5aab0..3ea1736 100644 (file)
@@ -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 {
index d2e83be..26f7a69 100644 (file)
@@ -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
index 070d965..72f4bb7 100644 (file)
@@ -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   = '';
index 237a38d..82c0521 100644 (file)
@@ -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,
index 0031d6e..fc81fdf 100644 (file)
@@ -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   = '';
index bfc5223..99d31bd 100644 (file)
@@ -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
index 2beb3de..4abdc39 100644 (file)
@@ -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'>.
 
index 89e5cbe..3062f59 100644 (file)
@@ -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()
index 4200140..632f417 100644 (file)
@@ -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 (file)
--- 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 */
old mode 100644 (file)
new mode 100755 (executable)
old mode 100644 (file)
new mode 100755 (executable)
index 3e3e0e3..b8108d2 100644 (file)
@@ -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 (file)
--- 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;
index bd0ba16..ae266de 100644 (file)
@@ -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);