Rework our handling of blocks and their interaction with packages som…

…ewhat. We were running into problems with parametric role signature variables ending up with the wrong scoping. This replaces the buggy fix I put in yesterday. We do diverge from STD, but STD gets this wrong also at the moment.

src/Perl6/Actions.pm

@@ -45,6 +45,7 @@ method comp_unit($/, $key?) {
     # If this is the start of the unit, add an outer module.
     if $key eq 'open' {
         @PACKAGE.unshift(Perl6::Compiler::Module.new());
+        @PACKAGE[0].block(@BLOCK[0]);
         return 1;
     }
 
@@ -241,9 +242,6 @@ method newpad($/) {
         )
     ));
     @BLOCK.unshift($new_block);
-    unless @PACKAGE[0].block {
-        @PACKAGE[0].block($new_block);
-    }
 }
 
 method outerlex($/) {
@@ -632,14 +630,6 @@ method module_name($/) {
     }
 }
 
-method def_module_name($/) {
-    # Clean up block stack to remove fake block we added for
-    # parsing the signature.
-    if $<signature> {
-        @BLOCK.shift;
-    }
-}
-
 method fatarrow($/) {
     make make_pair($<key>.Str, $<val>.ast);
 }
@@ -784,7 +774,7 @@ method package_def($/, $key?) {
         if $<def_module_name> {
             my $name := ~$<def_module_name>[0]<longname><name>;
             if $name ne '::' {
-                $/.CURSOR.add_name($name);
+                $/.CURSOR.add_name($name, 1);
                 $package.name($name);
             }
             if $<def_module_name>[0]<signature> {
@@ -803,6 +793,9 @@ method package_def($/, $key?) {
             $package.traits.push($_.ast);
         }
 
+        # Claim currently open block as the package's block.
+        $package.block(@BLOCK[0]);
+
         # Put on front of packages list. Note - nesting a package in a role is
         # not supported (gets really tricky in the parametric case - needs more
         # thought and consideration).
@@ -814,7 +807,7 @@ method package_def($/, $key?) {
     else {
         # We just need to finish up the current package.
         my $package := @PACKAGE.shift;
-        if pir::substr__SSII($<block><blockoid><statementlist><statement>[0], 0, 3) eq '...' {
+        if pir::substr__SSII($<blockoid><statementlist><statement>[0], 0, 3) eq '...' {
             # Just a stub, so don't do any more work.
             if $*SCOPE eq 'our' || $*SCOPE eq '' {
                 %Perl6::Grammar::STUBCOMPILINGPACKAGES{~$<def_module_name>[0]<longname>} := 1;
@@ -824,8 +817,8 @@ method package_def($/, $key?) {
         }
         else {
             my $block;
-            if $<block> {
-                $block := $<block>.ast;
+            if $<blockoid> {
+                $block := $<blockoid>.ast;
             }
             else {
                 $block := @BLOCK.shift;

src/Perl6/Grammar.pm

@@ -27,11 +27,11 @@ method TOP() {
     self.comp_unit;
 }
 
-method add_my_name($name) {
+method add_my_name($name, $up_levels = 0) {
     my @BLOCK := Q:PIR{ %r = get_hll_global ['Perl6';'Actions'], '@BLOCK' };
 
     # We need to flag up most re-declaration collisions.
-    my $cur_decl := @BLOCK[0].symbol($name);
+    my $cur_decl := @BLOCK[$up_levels].symbol($name);
     if $cur_decl {
         if $*PKGDECL eq 'role' || $cur_decl<stub> {
             return 1;
@@ -42,11 +42,11 @@ method add_my_name($name) {
     }
 
     # Add it.
-    @BLOCK[0].symbol($name, :does_abstraction(1));
+    @BLOCK[$up_levels].symbol($name, :does_abstraction(1));
     return 1;
 }
 
-method add_our_name($name) {
+method add_our_name($name, $up_levels = 0) {
     our %COMPILINGPACKAGES;
     our %STUBCOMPILINGPACKAGES;
 
@@ -76,10 +76,10 @@ method add_our_name($name) {
     %COMPILINGPACKAGES{$name} := 1;
 
     # Always need to add our names as lexical names too.
-    return self.add_my_name($name);
+    return self.add_my_name($name, $up_levels);
 }
 
-method add_name($name) {
+method add_name($name, $up_levels = 0) {
     if $*SCOPE eq 'augment' || $*SCOPE eq 'supersede' {
         unless self.is_name($name) {
             pir::die("Can't $*SCOPE $*PKGDECL that doesn't exist");
@@ -90,10 +90,10 @@ method add_name($name) {
     }
     else {
         if $*SCOPE eq 'our' {
-            self.add_our_name($name);
+            self.add_our_name($name, $up_levels);
         }
         else {
-            self.add_my_name($name);
+            self.add_my_name($name, $up_levels);
         }
     }
     return 1;
@@ -171,9 +171,7 @@ token def_module_name {
         <?before '['>
         <?{ $*PKGDECL eq 'role' }>
         :my $*SCOPE := 'my';
-        <.newpad>
         '[' ~ ']' <signature>
-        <.finishpad>
     ]?
 }
 
@@ -258,10 +256,10 @@ token comp_unit {
     :my $*MULTINESS := '';                     # which multi declarator we're under
     :my $*QSIGIL := '';                        # sigil of current interpolation
     :my $*TYPENAME := '';
-    {*} #= open
     <.newpad>
     <.outerlex>
     <.finishpad>
+    {*} #= open
     <statementlist>
     [ $ || <.panic: 'Confused'> ]
 }
@@ -795,15 +793,15 @@ token package_declarator:sym<does> {
 
 rule package_def {
     :my $*IN_DECL := 'package';
+    <.newpad>
     <def_module_name>?
     <trait>*
     {*} #= open
     [
     || ';'
-        <.newpad>
         <.finishpad>
         <statementlist>
-    || <?[{]> <block>
+    || <?[{]> <blockoid>
     || <.panic: 'Malformed package declaration'>
     ]
 }