2nd generation prototype: check diff between default_config.ph and

config.ph and translate rules bsaed on config.ph vlaues.

fix copyright of module header template.

1 files changed, 98 insertions, 44 deletions

diff --git a/regress/fml4to8/gen_rules.pl b/regress/fml4to8/gen_rules.pl
index 1c41f309..5f9cba52 100755
--- a/regress/fml4to8/gen_rules.pl
+++ b/regress/fml4to8/gen_rules.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/env perl
 #
-# $FML: gen_rules.pl,v 1.3 2004/12/30 04:43:37 fukachan Exp $
+# $FML: gen_rules.pl,v 1.4 2006/01/01 14:05:22 fukachan Exp $
 #
 
 use strict;
@@ -10,6 +10,9 @@ my $debug     = $ENV{'debug'} || 0;
 my $var_rules = {};
 my $var_count = 0;
 my $recursive = 0;
+my $if_state  = 0;
+my $if_stack  = 0;
+my (@if_stack) = ();
 my $ignore_regexp = 'unavailable|not_yet_configurable';
 
 # 1. read RULES.txt
@@ -109,6 +112,10 @@ sub _preamble
 #     DO NOT EDIT THIS FILE BY HAND!.
 #     THIS FILE IS AUTOMATICALLY GENERATED BY $prog.
 #
+#  Copyright (C) 2005,2006 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
 # \$FML\$
 #
 };
@@ -156,7 +163,6 @@ sub _trailor
 sub _print_translated_rules
 {
     my ($var_name, $var_rules) = @_;
-    my $rule_out = '';
     my $found    = 0;
     my $i        = 0;
 
@@ -171,7 +177,8 @@ sub _print_translated_rules
 
 	# 1st level (/^.if .../ statement)
 	if ($rule =~ /^\.if/o) {
-	    $rule_out .= _puts(_parse_if($rule, $recursive));
+	    _parse_if($rule, $recursive);
+	    $if_state = 1;
 	}
 	elsif ($rule =~ /^\S+/) {
 	    print STDERR "UNKNOWN RULE: <$rule>\n";
@@ -183,52 +190,61 @@ sub _print_translated_rules
 
 	    if ($rule =~ /^\.if/o) {
 		$recursive++;
-		$rule_out .= _puts(_parse_if($rule, $recursive));
+		_parse_if($rule, $recursive);
+		$if_state = 1;
 		next RULE;
 	    }
 
+	    # .if statement(s) stacked.
+	    if ($if_state) {
+		_print_if();
+	    }
+
 	    if ($rule eq '.use_fml4_value') {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \&\$fp_rule_prefer_fml4_value(\$self, \$config, \$diff, \$key, \$value);");
+		_print("\$s .= \&\$fp_rule_prefer_fml4_value(\$self, \$config, \$diff, \$key, \$value);");
 	    }
 	    elsif ($rule eq '.use_fml8_value') {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \&\$fp_rule_prefer_fml8_value(\$self, \$config, \$diff, \$key, \$value);");
+		_print("\$s .= \&\$fp_rule_prefer_fml8_value(\$self, \$config, \$diff, \$key, \$value);");
 	    }
 	    elsif ($rule eq '.convert') {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \&\$fp_rule_convert(\$self, \$config, \$diff, \$key, \$value);");
+		_print("\$s .= \&\$fp_rule_convert(\$self, \$config, \$diff, \$key, \$value);");
 	    }
 	    elsif ($rule =~ /^\s*\.(ignore|not_support)/o) {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \&\$fp_rule_ignore(\$self, \$config, \$diff, \$key, \$value);");
+		_print("\$s .= \&\$fp_rule_ignore(\$self, \$config, \$diff, \$key, \$value);");
 	    }
 	    elsif ($rule =~ /^\s*\.(not_yet_implemented)/o) {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \&\$fp_rule_not_yet_implemented(\$self, \$config, \$diff, \$key, \$value);");
+		_print("\$s .= \&\$fp_rule_not_yet_implemented(\$self, \$config, \$diff, \$key, \$value);");
 	    }
 	    elsif ($rule =~ /^\s*\.($ignore_regexp)/o) {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \"\# $rule\";");
+		_print("\$s .= \"\# $rule\";");
 	    }
 	    else {
 		$found = 1;
-		$rule_out .= _puts("\$s .= \"$rule\";");
+		_print("\$s .= \"$rule\";");
 	    }
 
 	    while ($recursive > 0) {
-		$rule_out .= _puts("}");
+		_print("}");
 		$recursive--;
 	    }
 
+	    while ($if_stack > 0) {
+		_print("}");
+		$if_stack--;
+	    }
+
 	} # if 
     } # for my $rule (...)
 
     if ($found) {
-	$rule_out .= _puts("return \$s if defined \$s;");
-	$rule_out .= _puts("}");
-	$rule_out .= _puts("");
-	print $rule_out;
+	_print("return \$s if defined \$s;");
+	print "}\n";
     }
 }
 
@@ -240,40 +256,72 @@ sub _print_translated_rules
 sub _parse_if
 {
     my ($rule, $recursive) = @_;
-    my $rule_out = '';
-
-    if ($rule =~ /^\.if\s+(\S+)\s+(==|>|>=|<|<=)\s+(\S+)/) {
-	$rule_out .= "\n";
-	my ($key, $op, $value) = ($1, $2, $3);
-	if ($value =~ /^\d+$/o) {
-	    $rule_out .= _puts("if (\$key eq '$key' && \$value $op $value) {");
-	    $rule_out .= _puts("\$s = undef;");
+
+    push(@if_stack, $rule);
+}
+
+
+sub _print_if
+{
+    my $i = 0;
+
+    # 1. check if differences are found.
+    print "if (";
+    for my $rule (@if_stack) {
+	if ($i) {
+	    print " || ";
 	}
-	else {
-	    $rule_out .= _puts("if (\$key eq '$key' && \$value eq '$value') {");
-	    $rule_out .= _puts("\$s = undef;");
+	if ($rule =~ /^\.if\s+(\S+)/) {
+	    print "\$diff->{ $1 }";
+	    $i++;
 	}
     }
-    elsif ($rule =~ /^\.if\s+(\S+)\s+\!=\s+(\S+)/) {
-	$rule_out .= "\n";
-	my ($key, $value) = ($1, $2);
-	if ($value =~ /^\d+$/o) {
-	    $rule_out .= _puts("if (\$key eq '$key' && \$value \!= $value) {");
-	    $rule_out .= _puts("\$s = undef;");
+    print ") {\n";
+
+    # 2. translate rules based on config.ph values.
+    __print_if(@if_stack);
+
+    # 3. declare "close 1.";
+    $if_stack++;
+
+    # 4. reset
+    @if_stack = ();
+}
+
+
+sub __print_if
+{
+    my (@rules)  = @_;
+
+    for my $rule (@rules) {
+	if ($rule =~ /^\.if\s+(\S+)\s+(==|>|>=|<|<=)\s+(\S+)/) {
+	    my ($key, $op, $value) = ($1, $2, $3);
+	    if ($value =~ /^\d+$/o) {
+		_print("if (\$config->{ $key } $op $value) {");
+		_print("\$s = undef;");
+	    }
+	    else {
+		_print("if (\$config->{ $key } eq '$value') {");
+		_print("\$s = undef;");
+	    }
 	}
-	else {
-	    $rule_out .= _puts("if (\$key eq '$key' && \$value ne '$value') {");
-	    $rule_out .= _puts("\$s = undef;");
+	elsif ($rule =~ /^\.if\s+(\S+)\s+\!=\s+(\S+)/) {
+	    my ($key, $value) = ($1, $2);
+	    if ($value =~ /^\d+$/o) {
+		_print("if (\$config->{ $key } \!= $value) {");
+		_print("\$s = undef;");
+	    }
+	    else {
+		_print("if (\$config->{ $key } ne '$value') {");
+		_print("\$s = undef;");
+	    }
+	}
+	elsif ($rule =~ /^\.if\s+(\S+)\s*$/) {
+	    my ($key) = $1;
+	    _print("if (\$config->{ $key }) {");
+	    _print("\$s = undef;");
 	}
     }
-    elsif ($rule =~ /^\.if\s+(\S+)\s*$/) {
-	$rule_out .= "\n";
-	my $key = $1;
-	$rule_out .= _puts("if (\$key eq '$key' && defined \$value) {");
-	$rule_out .= _puts("\$s = undef;");
-    }
-
-    return $rule_out;
 }
 
 
@@ -291,3 +339,9 @@ sub _puts
     my $rule_out = "    " x ($recursive + 1);
     return sprintf("%s%s\n", $rule_out, $s);
 }
+
+sub _print
+{
+    my ($s) = @_;
+    print _puts($s);
+}