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