r5801 - in trunk/gta02-core/bom: . test test/3
werner at docs.openmoko.org
werner at docs.openmoko.org
Thu Jan 28 20:36:30 CET 2010
Author: werner
Date: 2010-01-28 20:36:30 +0100 (Thu, 28 Jan 2010)
New Revision: 5801
Added:
trunk/gta02-core/bom/test/3/
trunk/gta02-core/bom/test/3/3.sub
trunk/gta02-core/bom/test/3/Makefile
trunk/gta02-core/bom/test/3/print.pl
Modified:
trunk/gta02-core/bom/parser.pl
Log:
Tested .chr/.sub and fixed lots of bugs.
- bom/parser.py (chr): @f was declared in the wrong scope
- bom/parser.py (chr): need more sleep - $1/$2 aren't $`/$'
- bom/parser.py (sub): fixed a gazillion of bugs
- bom/test/3/: test case for .sub files
Modified: trunk/gta02-core/bom/parser.pl
===================================================================
--- trunk/gta02-core/bom/parser.pl 2010-01-28 08:25:08 UTC (rev 5800)
+++ trunk/gta02-core/bom/parser.pl 2010-01-28 19:36:30 UTC (rev 5801)
@@ -117,17 +117,18 @@
sub chr
{
+ my @f;
if (/^\s+/) {
- my @f = split(/\s+/, $');
+ @f = split(/\s+/, $');
} else {
- my @f = split(/\s+/);
+ @f = split(/\s+/);
my $ref = shift @f;
my $num = shift @f;
$last = "$ref $num";
}
for (@f) {
die unless /=/;
- $chr{$last}{uc($1)} = $2;
+ $chr{$last}{uc($`)} = $';
}
}
@@ -143,9 +144,9 @@
# $action_stack[depth]{field} = value
# $may_cont = 0 / 1
# $last
+# $last_action
#
# to do:
-# - test this
# - unit canonicalization
# - glob to RE rewriting for pattern
# - $n expansion for value
@@ -153,14 +154,16 @@
sub sub
{
- /^\s*/;
- my $indent = $&;
+ /^(\s*)/;
+ my $indent = $1;
my @f = split(/\s+/, $');
+ my $f;
my $in = 0; # indentation level
- while (/^./ =~ $indent) {
- if ($& eq " ") {
+ while (length $indent) {
+ my $c = substr($indent, 0, 1, "");
+ if ($c eq " ") {
$in++;
- } elsif ($& eq "\t") {
+ } elsif ($c eq "\t") {
$in = ($in+8) & ~7;
} else {
die;
@@ -169,47 +172,57 @@
if ($may_cont && $in > $last) {
pop(@match);
pop(@action);
+ pop(@end);
} else {
$match_stack[0] = undef;
$action_stack[0] = undef;
+ $last_action = 0;
+ $last = $in;
}
- $last = $in;
- while (@f) {
- my $f = shift @f;
- last if $f eq "->" || $f eq "{" || $f eq "}" || $f eq "!";
- if ($f =~ /=/) {
- $match_stack[0]{"REF"} = $f;
- } else {
- $match_stack[0]{uc($`)} = $';
+ if (!$last_action) {
+ while (@f) {
+ $f = shift @f;
+ last if $f eq "->" || $f eq "{" || $f eq "}" || $f eq "!";
+ if ($f =~ /=/) {
+ $match_stack[0]{uc($`)} = $';
+ } else {
+ $match_stack[0]{"REF"} = $f;
+ }
}
+ $last_action = 1 if $f eq "->";
}
- if ($f eq "->") {
+ if ($last_action) {
while (@f) {
- my $f = shift @f;
+ $f = shift @f;
last if $f eq "{" || $f eq "!";
+ die unless $f =~ /=/;
+ $action_stack[0]{uc($`)} = $';
}
- die unless /=/;
- $action_stack[0]{uc($`)} = $';
}
$may_cont = 0;
if ($f eq "{") {
unshift(@match_stack, undef);
unshift(@action_stack, undef);
+ die "items following {" if @f;
} elsif ($f eq "}") {
shift @match_stack;
shift @action_stack;
+ die "items following }" if @f;
} else {
+ die "items following !" if @f && $f eq "!";
push(@end, $f eq "!");
$may_cont = $f ne "!";
my $n = $#end;
- for $m (@match_stack) {
- for (keys %{ $_ }) {
- $match[$n]{$_} = $m{$_};
+ push(@match, undef);
+ push(@action, undef);
+ for my $m (@match_stack) {
+ for (keys %{ $m }) {
+ $match[$n]{$_} = $m->{$_};
}
}
- for $a (@action_stack) {
- for (keys %{ $_ }) {
- $action[$n]{$_} = $m{$_};
+ for my $a (@action_stack) {
+ for (keys %{ $a }) {
+ $action[$n]{$_} = $a->{$_};
}
}
}
@@ -245,6 +258,7 @@
if (/^#SUB\b/) {
$mode = *sub;
undef $last;
+ undef $last_action;
undef $may_cont;
next;
}
Added: trunk/gta02-core/bom/test/3/3.sub
===================================================================
--- trunk/gta02-core/bom/test/3/3.sub (rev 0)
+++ trunk/gta02-core/bom/test/3/3.sub 2010-01-28 19:36:30 UTC (rev 5801)
@@ -0,0 +1,17 @@
+#SUB
+# note: these rules don't make sense. they just serve to test the parser.
+C* {
+ foo=bar -> a=b
+ foo=bar
+ x=y -> a=c
+ foo=bar
+ x=y ->
+ a=b
+ foo=bar x=y ->
+ a=b !
+ foo=bar x=z -> z=zulu
+ { # indentation required !
+ y=0 -> t=a
+ y=1 -> t=b
+ }
+}
Added: trunk/gta02-core/bom/test/3/Makefile
===================================================================
--- trunk/gta02-core/bom/test/3/Makefile (rev 0)
+++ trunk/gta02-core/bom/test/3/Makefile 2010-01-28 19:36:30 UTC (rev 5801)
@@ -0,0 +1,2 @@
+all:
+ perl -I../.. ./print.pl 3.sub
Added: trunk/gta02-core/bom/test/3/print.pl
===================================================================
--- trunk/gta02-core/bom/test/3/print.pl (rev 0)
+++ trunk/gta02-core/bom/test/3/print.pl 2010-01-28 19:36:30 UTC (rev 5801)
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+require "parser.pl";
+&parse;
+
+for $k (sort keys %chr) {
+ for $p (sort keys %{ $chr{$k} }) {
+ print "chr{$k}{$p} = $chr{$k}{$p}\n";
+ }
+}
+for ($i = 0; $i != @end; $i++) {
+ for (sort keys %{ $match[$i] }) {
+ print "$_=$match[$i]{$_} ";
+ }
+ print "->";
+ for (sort keys %{ $action[$i] }) {
+ print " $_=$action[$i]{$_}";
+ }
+ print $end[$i] ? " !\n" : "\n";
+}
Property changes on: trunk/gta02-core/bom/test/3/print.pl
___________________________________________________________________
Name: svn:executable
+ *
More information about the commitlog
mailing list