modify private function names.

fix bug of output indent level.
croak() if unknown rule found.

1 files changed, 62 insertions, 45 deletions

diff --git a/regress/fml4to8/gen_rules.pl b/regress/fml4to8/gen_rules.pl
index 5f9cba52..95c0825f 100755
--- a/regress/fml4to8/gen_rules.pl
+++ b/regress/fml4to8/gen_rules.pl
@@ -1,17 +1,17 @@
 #!/usr/bin/env perl
 #
-# $FML: gen_rules.pl,v 1.4 2006/01/01 14:05:22 fukachan Exp $
+# $FML: gen_rules.pl,v 1.5 2006/01/04 06:45:52 fukachan Exp $
 #
 
 use strict;
 use Carp;
 
-my $debug     = $ENV{'debug'} || 0;
-my $var_rules = {};
-my $var_count = 0;
-my $recursive = 0;
-my $if_state  = 0;
-my $if_stack  = 0;
+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';
 
@@ -19,22 +19,23 @@ my $ignore_regexp = 'unavailable|not_yet_configurable';
 _parse_rule_file(@ARGV);
 
 # 2. show translation rules (perl script).
-_preamble();
+_print_preamble();
 for my $var_name (sort {$a <=> $b} keys %$var_rules) {
-    $recursive = 0;
     _print_translated_rules($var_name, $var_rules->{ $var_name });
 }
-_trailor();
+_print_trailor();
 
 exit 0;
 
 
-=head1 INITIALIZATION
-
-=cut
+######################################################################
+#
+# INITIALIZATION
+#
+######################################################################
 
 
-# Descriptions: 
+# Descriptions: parse rules in specified file.
 #    Arguments: STR($rule_file)
 # Side Effects: update $var_rules HASH_REF.
 # Return Value: none
@@ -92,23 +93,25 @@ sub _parse_rule_file
 }
 
 
-=head1 TRANSLATION OF RULES
-
-=cut
+######################################################################
+#
+# MODULE TEMPLATE
+#
+######################################################################
 
 
 # Descriptions: print out preamble of output of perl script.
 #    Arguments: none
 # Side Effects: none
 # Return Value: none
-sub _preamble
+sub _print_preamble
 {
     use File::Basename;
     my $prog = basename($0);
 
     print qq{#
 # -*- perl -*-
-#     *** CAUTION *** 
+#     *** CAUTION ***
 #     DO NOT EDIT THIS FILE BY HAND!.
 #     THIS FILE IS AUTOMATICALLY GENERATED BY $prog.
 #
@@ -126,7 +129,7 @@ package FML::Merge::FML4::Rules;
 
 # Descriptions: translate fml4 rule to the corresponding fml8 one.
 #    Arguments: OBJ($self)
-#               HASH_REF($dispatch) HASH_REF($config) HASH_REF($diff) 
+#               HASH_REF($dispatch) HASH_REF($config) HASH_REF($diff)
 #               STR($key) STR($value)
 # Side Effects: none
 # Return Value: STR
@@ -138,7 +141,7 @@ sub translate
     my $fp_rule_prefer_fml8_value   = $dispatch->{ rule_prefer_fml8_value };
     my $fp_rule_ignore              = $dispatch->{ rule_ignore };
     my $fp_rule_not_yet_implemented = $dispatch->{ rule_not_yet_implemented };
-    my $s;
+    my $s = undef;
 
 !;
 }
@@ -148,7 +151,7 @@ sub translate
 #    Arguments: none
 # Side Effects: none
 # Return Value: none
-sub _trailor
+sub _print_trailor
 {
     print "\n   return '';\n";
     print "} # sub translate\n";
@@ -156,6 +159,13 @@ sub _trailor
 }
 
 
+######################################################################
+#
+# TRANSLATION OF RULES
+#
+######################################################################
+
+
 # Descriptions: print out translated rules.
 #    Arguments: STR($var_name) STR($var_rules)
 # Side Effects: none
@@ -181,7 +191,7 @@ sub _print_translated_rules
 	    $if_state = 1;
 	}
 	elsif ($rule =~ /^\S+/) {
-	    print STDERR "UNKNOWN RULE: <$rule>\n";
+	    croak("UNKNOWN RULE: <$rule>\n");
 	}
 	# 2nd level (/^\s+\S+/ statement)
 	else {
@@ -189,7 +199,6 @@ sub _print_translated_rules
 	    $rule =~ s/\s*$//;
 
 	    if ($rule =~ /^\.if/o) {
-		$recursive++;
 		_parse_if($rule, $recursive);
 		$if_state = 1;
 		next RULE;
@@ -229,22 +238,18 @@ sub _print_translated_rules
 		_print("\$s .= \"$rule\";");
 	    }
 
-	    while ($recursive > 0) {
-		_print("}");
-		$recursive--;
-	    }
-
 	    while ($if_stack > 0) {
-		_print("}");
 		$if_stack--;
+		_print("}");
 	    }
 
-	} # if 
+	} # if
     } # for my $rule (...)
 
     if ($found) {
 	_print("return \$s if defined \$s;");
-	print "}\n";
+	_print("\$s = undef;");
+	_print("\n");
     }
 }
 
@@ -266,7 +271,8 @@ sub _print_if
     my $i = 0;
 
     # 1. check if differences are found.
-    print "if (";
+    __print("if (");
+    $if_stack++;
     for my $rule (@if_stack) {
 	if ($i) {
 	    print " || ";
@@ -281,10 +287,7 @@ sub _print_if
     # 2. translate rules based on config.ph values.
     __print_if(@if_stack);
 
-    # 3. declare "close 1.";
-    $if_stack++;
-
-    # 4. reset
+    # 3. reset
     @if_stack = ();
 }
 
@@ -298,10 +301,12 @@ sub __print_if
 	    my ($key, $op, $value) = ($1, $2, $3);
 	    if ($value =~ /^\d+$/o) {
 		_print("if (\$config->{ $key } $op $value) {");
+		$if_stack++;
 		_print("\$s = undef;");
 	    }
 	    else {
 		_print("if (\$config->{ $key } eq '$value') {");
+		$if_stack++;
 		_print("\$s = undef;");
 	    }
 	}
@@ -309,39 +314,51 @@ sub __print_if
 	    my ($key, $value) = ($1, $2);
 	    if ($value =~ /^\d+$/o) {
 		_print("if (\$config->{ $key } \!= $value) {");
+		$if_stack++;
 		_print("\$s = undef;");
 	    }
 	    else {
 		_print("if (\$config->{ $key } ne '$value') {");
+		$if_stack++;
 		_print("\$s = undef;");
 	    }
 	}
 	elsif ($rule =~ /^\.if\s+(\S+)\s*$/) {
 	    my ($key) = $1;
 	    _print("if (\$config->{ $key }) {");
+	    $if_stack++;
 	    _print("\$s = undef;");
 	}
     }
 }
 
 
-=head1 UTILITIES
+######################################################################
+#
+# UTILITIES
+#
+######################################################################
 
-=cut
 
-# Descriptions: printf wrapper to prepend spaces in a line.
+# Descriptions: print wrapper to prepend spaces in a line.
 #    Arguments: STR($s)
 # Side Effects: none
 # Return Value: none
-sub _puts
+sub _print
 {
     my ($s) = @_;
-    my $rule_out = "    " x ($recursive + 1);
-    return sprintf("%s%s\n", $rule_out, $s);
+    my $rule_out = "    " x ($if_stack + 1);
+    printf("%s%s\n", $rule_out, $s);
 }
 
-sub _print
+
+# Descriptions: print wrapper to prepend spaces in a line without "\n".
+#    Arguments: STR($s)
+# Side Effects: none
+# Return Value: none
+sub __print
 {
     my ($s) = @_;
-    print _puts($s);
+    my $rule_out = "    " x ($if_stack + 1);
+    printf("%s%s", $rule_out, $s);
 }