Fix A::B installing B alias, setting breakage

FROGGS · Mar 7, 2011 · ade14b1 · ade14b1
1 parent 8f6f087
commit ade14b1
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 8 deletions.
diff --git a/src/NieczaPassBegin.pm6 b/src/NieczaPassBegin.pm6
@@ -362,13 +362,13 @@ augment class Op::PackageDef { #OK exist
         }
 
         my @ns = $.ourpkg ??
-            (@( @*opensubs[*-1].find_pkg($.ourpkg) ), $.var) !!
+            (@( @*opensubs[*-1].find_pkg($.ourpkg) ), $.ourvar) !!
             $*unit.anon_stash;
         my $n = pop(@ns);
 
         $*unit.create_stash([@ns, $n]);
         @*opensubs[*-1].add_my_stash($.var, [ @ns, $n ]);
-        @*opensubs[*-1].add_pkg_exports($*unit, $.var, [ @ns, $n ], $.exports);
+        @*opensubs[*-1].add_pkg_exports($*unit, $.name, [ @ns, $n ], $.exports);
         if !$.stub {
             my $obj  = $pclass.new(name => $.name).xref;
             $*unit.bind_item([ @ns, $n ], $obj);

diff --git a/src/Op.pm6 b/src/Op.pm6
@@ -580,6 +580,7 @@ class PackageDef is Op {
     has $.body; # Body
     has $.exports = []; # Array of Str
     has $.ourpkg; # Array of Str
+    has $.ourvar; # Str
 
     method code($ ) {
         if $.stub {

diff --git a/src/niecza b/src/niecza
@@ -102,7 +102,7 @@ method package_def ($/) {
     my $optype = %_decl2class{$*PKGDECL};
     my $blocktype = $*PKGDECL;
     my $bodyvar = self.gensym;
-    my $ourpkg = Any;
+    my ($ourpkg, $ourvar);
 
     if $scope eq 'augment' {
         my $r = self.mangle_longname($<longname>[0]);
@@ -111,14 +111,15 @@ method package_def ($/) {
     } elsif $<longname> {
         my $r = self.mangle_longname($<longname>[0]);
         $name = $r<name>;
-        if ($r<name>:exists) && $scope ne 'our' {
+        if ($r<path>:exists) && $scope ne 'our' {
             $/.CURSOR.sorry("Block name $<longname> requires our scope");
             $scope = 'our';
         }
-        $ourpkg = ($r<path>:exists) ?? $r<path> !! ['OUR'];
-        # TODO: no lexical alias for %r<path>:exists
-        # (Requires adding a separate "ourname" slot in Op::PackageDef)
-        $outervar = ($scope eq 'anon') ?? self.gensym
+        if $scope eq 'our' {
+            $ourpkg = ($r<path>:exists) ?? $r<path> !! ['OUR'];
+            $ourvar = $r<name>;
+        }
+        $outervar = ($scope eq 'anon' || ($r<path>:exists)) ?? self.gensym
             !! $name;
     } else {
         $name = 'ANON';
@@ -154,13 +155,15 @@ method package_def ($/) {
             exports => @export,
             bodyvar => $bodyvar,
             ourpkg  => $ourpkg,
+            ourvar  => $ourvar,
             body    => $cbody);
     } else {
         make $optype.new(
             |node($/),
             name    => $name,
             var     => $outervar,
             ourpkg  => $ourpkg,
+            ourvar  => $ourvar,
             stub    => True);
     }
 }

diff --git a/test2.pl b/test2.pl
@@ -23,6 +23,9 @@
     }
 
     is Foo9215::Inner.pie, 64, ":: class names work, without predecl";
+
+    eval_dies_ok 'my class A::B { }', 'cannot use :: with my';
+    eval_dies_ok 'my class A::B { }; B', 'A::B does not install B alias';
 }
 
 #is $?FILE, 'test.pl', '$?FILE works';