Select Code to Download

cd build
mkdir perl-current
cd perl-current
rsync -avz rsync://ftp.linux.activestate.com/perl-current/ .

sh Configure -Doptimize='-g' -Dusethreads -Dusedevel -Dprefix=/local/p
+erl
-ders && make

perl -e 'my *x'

syntax error at -e line 1, near "my *x"

/* "my" declarations, with optional attributes */
myattrterm:     MY myterm myattrlist
...
       |       ary     %prec '('
                       { $$ = $1; }
       ;

scalar  :       '$' indirob
                        { $$ = newSVREF($2); }
...
hsh     :       '%' indirob
                        { $$ = newHVREF($2); }
        ;

star    :       '*' indirob
                        { $$ = newGVREF(0,$2); }
        ;

       |       star    %prec '('
                       { $$ = $1; }

  perl regen_perly.pl
  make perl

  $ ./perl -e 'my *x'
  Can't declare ref-to-glob cast in "my" at -e line 1, at EOF

$ ./perl -MO=Concise -e 'my $x; my @y; my %z' 
8  <@> leave[1 ref] vKP/REFC ->(end)
...
6     <;> nextstate(main 3 -e:1) v ->7
7     <0> padhv[%z:3,4] vM/LVINTRO ->8
-e syntax OK

$ diff -u opcode.pl{.orig,}
--- opcode.pl.orig      2005-10-18 19:07:24.000000000 +0100
...
 padany         private value           ck_null         d0
 
 pushre         push regexp             ck_null         d/

--- op.c.before 2005-10-18 19:13:33.000000000 +0100
+++ op.c        2005-10-18 19:33:09.000000000 +0100
...
        return newUNOP(OP_NULL, 0, o);
     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
 }

--- pp.c.orig   2005-10-18 19:16:07.000000000 +0100
+++ pp.c        2005-10-18 19:17:51.000000000 +0100
...
 PP(pp_padany)
 {
     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);

$ ./perl -MO=Concise -e 'my *x'
Can't declare ref-to-glob cast in "my" at -e line 1, at EOF
...
2     <;> nextstate(main 1 -e:1) ->3
4     <1> rv2gv sKR/1 ->5
3        <#> gv[*x] s ->4

$ gdb --args ./perl -e 'my *x'
...
...
$1 = {op_next = 0x81ccc50, op_sibling = 0x0, 
  op_ppaddr = 0x80e2c0c <Perl_pp_const>, op_targ = 0, op_type = 5, op_
+opt = 0, 
  op_static = 0, op_spare = 0, op_flags = 2 '\002', op_private = 16 '\
+020'}

$ grep OP_PADANY *.c
...
toke.c:            yylval.opval = newOP(OP_PADANY, 0);
toke.c:            yylval.opval = newOP(OP_PADANY, 0);

...
if (PL_pending_ident)
  return REPORT(S_pending_ident(aTHX));
...

--- toke.c.orig 2005-10-18 19:47:57.000000000 +0100
+++ toke.c      2005-10-18 19:48:43.000000000 +0100
...
            if (!*PL_tokenbuf)
                PREREF('*');
            TERM('*');

syntax error at ../lib/vars.pm line 29, near "*$sym "

$ ./miniperl -DT -ce '*$x'
### 0:LEX_NORMAL/XSTATE "\n;"
...

syntax error at -e line 1, next char $
-e had compilation errors.

$ ./miniperl -DT -ce '%$x'
### 0:LEX_NORMAL/XSTATE "\n;"
...
EXECUTING...

-e syntax OK

--- toke.c.orig 2005-10-18 19:47:57.000000000 +0100
+++ toke.c      2005-10-18 20:16:52.000000000 +0100
...
            TERM('*');
        }
        s++;

Global symbol "%DELETE" requires explicit package name at lib/Config_h
+eavy.pl line 1158

*DELETE = \&STORE;

$ ./miniperl -ce '*foo'
-e syntax OK
$ ./miniperl -ce 'use strict; *foo'
Global symbol "%foo" requires explicit package name at -e line 1.
-e had compilation errors.

$ fgrep 'explicit package name' *.c
gv.c:            "Global symbol \"%s%s\" requires explicit package nam
+e",

$ gdb --args ./miniperl -e '*foo'
(gdb) br Perl_gv_fetchpvn_flags
...
#7  0x0804baeb in main (argc=3, argv=0xbffff3f4, env=0xbffff404)
    at miniperlmain.c:101
#8  0x42015704 in __libc_start_main () from /lib/tls/libc.so.6

    gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL
+) : TRUE,
               ((PL_tokenbuf[0] == '$') ? SVt_PV
                : (PL_tokenbuf[0] == '@') ? SVt_PVAV
                : SVt_PVHV));

--- toke.c.1    2005-10-18 20:53:32.000000000 +0100
+++ toke.c      2005-10-18 20:54:34.000000000 +0100
...
                 : SVt_PVHV));
     return WORD;
 }

$ ./perl -MO=Concise -e 'my *foo'
Can't declare private glob in "my" at -e line 1, at EOF
...
1     <0> enter ->2
2     <;> nextstate(main 1 -e:1) ->3
3     <0> padgv[*foo:1,2] ->4

$ fgrep "Can't declare" *.c
op.c:               "Can't declare class for non-scalar %s in \"%s\"",
...
opmini.c:                   "Can't declare class for non-scalar %s in 
+\"%s\"",
opmini.c:           yyerror(Perl_form(aTHX_ "Can't declare %s in %s",
opmini.c:       yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",

    else if (type != OP_PADSV &&
             type != OP_PADAV &&
...
                          PL_in_my == KEY_our ? "our" : "my"));
        return o;
    }

--- op.c.1      2005-10-18 21:03:51.000000000 +0100
+++ op.c        2005-10-18 21:04:11.000000000 +0100
...
             type != OP_PUSHMARK)
     {
        yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",

$ ./perl -e 'my *foo'
OP_PADGV NOT YET IMPLEMENTED at -e line 1.

--- pp.c.orig   2005-10-18 19:16:07.000000000 +0100
+++ pp.c        2005-10-18 22:23:28.000000000 +0100
...
 PP(pp_padany)
 {
     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);

$ ./perl -e 'my *foo = *bar'
Can't modify private glob in scalar assignment at -e line 1, at EOF

$ fgrep "Can't modify" *.c
op.c:   yyerror(Perl_form(aTHX_ "Can't modify %s in %s",

--- op.c.2      2005-10-18 21:43:38.000000000 +0100
+++ op.c        2005-10-18 21:44:12.000000000 +0100
...
        PL_modcount++;
        if (!type) /* local() */
            Perl_croak(aTHX_ "Can't localize lexical variable %s",

$ ./perl -we 'my *foo = *bar; print *foo, "\n"'
Name "main::bar" used only once: possible typo at -e line 1.
*main::bar

$ ./perl -we 'my *foo = *bar; $bar = "Hello, world!\n"; print ${*foo}'
Hello, world!

$ ./perl -we 'my *foo; print *foo{NAME}'
Segmentation fault

--- pp.c.1      2005-10-18 22:30:22.000000000 +0100
+++ pp.c        2005-10-19 00:47:33.000000000 +0100
...
+    XPUSHs(SvRV(TARG));
     RETURN;
 }

$ ./perl -wle 'print my *x'
*lexical::_GEN_0
...
$ ./perl -wle 'my *x = \23; *foo = *x; print $foo; $foo = 24'
23
Modification of a read-only value attempted at -e line 1.

sub foo {
  my *foo = shift;
...

my $y = foo(\23);
print $y->();

$ ./perl -wle 'for(1..10) {my *x} print sort keys %lexical::'
_GEN_0_GEN_1_GEN_2_GEN_3_GEN_4_GEN_5_GEN_6_GEN_7_GEN_8_GEN_9

$ ./perl -e 'while (1) {my *foo}'

--- pp.c.3      2005-10-19 01:26:19.000000000 +0100
+++ pp.c        2005-10-19 01:34:42.000000000 +0100
...
        SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     }
     XPUSHs(SvRV(TARG));

$ ./perl -wle 'for (1..10) {print \my *foo}'
GLOB(0x81b22d8)
...
GLOB(0x81b22f8)
GLOB(0x81b22b8)
GLOB(0x81b22d8)

#!./perl

...
my @foo = map foo($_), \(17, 23);
is($foo[0]->(), 17, 'Closure test ($foo[0] == 17)');
is($foo[1]->(), 23, 'Closure test ($foo[1] == 23)');

  
--- ext/Opcode/Opcode.pm.orig   2005-10-19 01:08:11.000000000 +0100
+++ ext/Opcode/Opcode.pm        2005-10-19 01:08:28.000000000 +0100
...
+    padsv padav padhv padgv padany
 
     rv2gv refgen srefgen ref

--- ext/Safe/t/safeops.t.orig   2005-10-19 02:13:20.000000000 +0100
+++ ext/Safe/t/safeops.t        2005-10-19 02:13:52.000000000 +0100
...
 SKIP (not implemented) # padany
 SKIP split /foo/ # pushre
 *x # rv2gv

--- ext/B/t/optree_concise.t.orig       2005-10-19 02:16:20.000000000 
++0100
+++ ext/B/t/optree_concise.t    2005-10-19 02:16:37.000000000 +0100
...
+#         UNOP (0x812fc20) null [16] 
 #             SVOP (0x812fc00) gvsv  GV (0x814692c) *a 
 EONT_EONT

--- patchlevel.h.orig   2005-10-19 03:31:04.000000000 +0100
+++ patchlevel.h        2005-10-19 03:32:24.000000000 +0100
...
        ,NULL
 };

  ...
  Locally applied patches:
        DEVEL25746
        LEXGLOB001 - lexically scoped globs!
  ...