Permalink
Browse files

[mm] Fix static $*foo cases, compiler driver

  • Loading branch information...
1 parent 6878346 commit d75ad08cfc65bec5e621c159563c4b95c74e8abb @sorear committed Sep 28, 2010
Showing with 55 additions and 54 deletions.
  1. +1 −1 Niecza.proj
  2. +8 −8 src/CSharpBackend.pm
  3. +2 −1 src/CompilerDriver.pm
  4. +1 −1 src/Metamodel.pm
  5. +1 −43 test.pl
  6. +42 −0 test2.pl
View
@@ -16,7 +16,7 @@
</PropertyGroup>
<ItemGroup>
- <CompilerPerl Include="src\Body.pm;src\CClass.pm;src\CgOp.pm;src\CodeGen.pm;src\CompilerDriver.pm;src\Decl.pm;src\Op.pm;src\Optimizer\Beta.pm;src\Optimizer\RxSimple.pm;src\ResolveLex.pm;src\RxOp.pm;src\Sig.pm;src\Unit.pm;src\Niecza\Actions.pm;src\Niecza\Grammar.pmc"/>
+ <CompilerPerl Include="src\Body.pm;src\CClass.pm;src\CgOp.pm;src\CSharpBackend.pm;src\CodeGen.pm;src\CompilerDriver.pm;src\Metamodel.pm;src\Op.pm;src\Optimizer\Beta.pm;src\Optimizer\RxSimple.pm;src\RxOp.pm;src\Sig.pm;src\Unit.pm;src\Niecza\Actions.pm;src\Niecza\Grammar.pmc"/>
</ItemGroup>
<!-- Meta targets -->
View
@@ -209,12 +209,11 @@ sub pkg3 {
sub enter_code {
my ($body) = @_;
my @code;
- # in this case, the variables were initialized earlier and are still useful
- goto novars if $body->run_once && $body->spad_exists;
-
for my $ln (sort keys %{ $body->lexicals }) {
my $lx = $body->lexicals->{$ln};
+ next if $body->run_once && $body->spad_exists && !dynname($ln);
+
if ($lx->isa('Metamodel::Lexical::SubDef')) {
push @code, access_lex($body, $ln,
CgOp::newscalar(CgOp::rawscall('Kernel.MakeSub',
@@ -271,7 +270,7 @@ sub access_lex {
if ($lex->isa('Metamodel::Lexical::SubDef') ||
$lex->isa('Metamodel::Lexical::Simple')) {
- if ($bp->run_once) {
+ if ($bp->run_once && !dynname($name)) {
return $set_to ? CgOp::rawsset($lex->{peer}, $set_to) :
CgOp::rawsget($lex->{peer});
} elsif ((my $ix = $lex->{peer}) >= 0) {
@@ -346,6 +345,7 @@ sub codegen_sub {
usednamed => $_->{peer}{uname}, minlets => $_->{peer}{nlexn});
}
+sub dynname { $_[0] =~ /^.?[*?]/ }
# lumped under a sub are all the static-y lexicals
# protopads and proto-sub-instances need to exist early because methods, in
# particular, bind to them
@@ -371,11 +371,11 @@ sub sub0 {
if ($lx->isa('Metamodel::Lexical::SubDef') ||
$lx->isa('Metamodel::Lexical::Simple')) {
- if ($_->run_once) {
- push @decls, ($lx->{peer} = gsym('Variable', $ln));
- } elsif ($ln =~ /^.?[*?]/) {
+ if (dynname($ln)) {
$lx->{peer} = -1;
$uname = 1;
+ } elsif ($_->run_once) {
+ push @decls, ($lx->{peer} = gsym('Variable', $ln));
} else {
$lx->{peer} = ($nlexn++);
}
@@ -437,7 +437,7 @@ sub sub2 {
sub protolset {
my ($body, $lname, $lex, $frag) = @_;
- if ($body->run_once) {
+ if ($body->run_once && !dynname($lname)) {
push @thaw, CgOp::rawsset($lex->{peer}, $frag);
} elsif ((my $ix = $lex->{peer}) >= 4) {
push @thaw, CgOp::setindex(CgOp::int($ix - 4),
@@ -254,6 +254,7 @@ sub compile {
}
print STDERR "@args\n" if $args{stagetime};
system @args;
+ $ast = undef;
} ],
[ 'aot', sub {
system "mono", "--aot", $outfile;
@@ -267,7 +268,7 @@ sub compile {
printf "%-20s: %gs\n", "$basename " . $p->[0],
$t2 - $t1 if $args{stagetime};
if ($args{stopafter} && $args{stopafter} eq $p->[0]) {
- if ($ast) {
+ if ($ast && $args{stopafter} ne 'writecs') {
print STDERR YAML::XS::Dump($ast);
}
return;
View
@@ -802,7 +802,7 @@ sub Op::Super::begin {
sub Op::SubDef::begin {
my $self = shift;
- my $body = $self->body->begin;
+ my $body = $self->body->begin(once => $self->once);
$opensubs[-1]->add_my_sub($self->var, $body);
my $r;
if (@{ $self->exports } || defined($self->method_too) ||
View
@@ -2,7 +2,7 @@
use Test;
-plan 534;
+plan 520;
ok 1, "one is true";
ok 2, "two is also true";
@@ -375,24 +375,6 @@
}
{
- class Foo {
- method foo() { 42 }
- class Bar {
- method bar() { 51 }
- }
- ok Bar.bar == 51, "within Foo, Bar is directly accessible";
- ok OUR::Bar.bar == 51, "within Foo, Bar is package accessible";
- ok Foo::Bar.bar == 51, "within Foo, Bar is longname accessible";
- ok GLOBAL::Foo::Bar.bar == 51, "within Foo, Bar is GLOBAL accessible";
- }
- ok Foo eq 'Foo()', "lexical lookup of our-class works";
- ok OUR::Foo eq 'Foo()', "also visible in ourpad";
- ok GLOBAL::Foo eq 'Foo()', "also visible globally";
- ok Foo::Bar.bar == 51, "can call through nested methods";
- ok GLOBAL::Foo::Bar.bar == 51, "can call through GLOBAL nested";
-}
-
-{
my $x1; my $x2; my $x3; my $x4;
$x1 = 1 if 0;
$x2 = 1 if 1;
@@ -615,30 +597,6 @@
}
{
- {
- our $x = 5; #OK
- }
- ok $::x == 5, '$::x finds our variable';
-
- package Fao { our $y = 6; } #OK
- ok $::Fao::y == 6, '$::Fao::y works as $Fao::y';
-
- { class Mao { } }
- ok ::Mao.new.defined, 'can use classes via ::Mao';
-}
-
-{
- my $x = 7; #OK
- ok $::x == 7, '$::x can find lexicals';
- class A3 {
- method moo { 42 }
- class B4 {
- ok ::A3.moo, '::A3 can find outer classes';
- }
- }
-}
-
-{
ok (&infix:<+>)(2,2) == 4, '&infix:<+> syntax works';
}
View
@@ -21,5 +21,47 @@
is $?FILE, 'test.pl', '$?FILE works';
is $?ORIG.substr(0,5), '# vim', '$?ORIG works';
+{
+ {
+ our $x = 5; #OK
+ }
+ ok $::x == 5, '$::x finds our variable';
+
+ package Fao { our $y = 6; } #OK
+ ok $::Fao::y == 6, '$::Fao::y works as $Fao::y';
+
+ { class Mao { } }
+ ok ::Mao.new.defined, 'can use classes via ::Mao';
+}
+
+{
+ my $x = 7; #OK
+ ok $::x == 7, '$::x can find lexicals';
+ class A3 {
+ method moo { 42 }
+ class B4 {
+ ok ::A3.moo, '::A3 can find outer classes';
+ }
+ }
+}
+
+{
+ class Foo {
+ method foo() { 42 }
+ class Bar {
+ method bar() { 51 }
+ }
+ ok Bar.bar == 51, "within Foo, Bar is directly accessible";
+ ok OUR::Bar.bar == 51, "within Foo, Bar is package accessible";
+ ok Foo::Bar.bar == 51, "within Foo, Bar is longname accessible";
+ ok GLOBAL::Foo::Bar.bar == 51, "within Foo, Bar is GLOBAL accessible";
+ }
+ ok Foo eq 'Foo()', "lexical lookup of our-class works";
+ ok OUR::Foo eq 'Foo()', "also visible in ourpad";
+ ok GLOBAL::Foo eq 'Foo()', "also visible globally";
+ ok Foo::Bar.bar == 51, "can call through nested methods";
+ ok GLOBAL::Foo::Bar.bar == 51, "can call through GLOBAL nested";
+}
+
done-testing;

0 comments on commit d75ad08

Please sign in to comment.