clean up

more strict consistency check with FNF.

2 files changed, 316 insertions, 20 deletions

diff --git a/regress/simulation/find_bad_style.pl b/regress/simulation/find_bad_style.pl
index c33df22a..e6a6e639 100755
--- a/regress/simulation/find_bad_style.pl
+++ b/regress/simulation/find_bad_style.pl
@@ -1,19 +1,29 @@
 #!/usr/bin/env perl
+#-*- perl -*-
 #
-# $FML: find_bad_style.pl,v 1.1 2002/06/01 05:06:22 fukachan Exp $
+#  Copyright (C) 2002,2003 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: find_bad_style.pl,v 1.2 2003/01/03 10:16:33 fukachan Exp $
 #
 
 use strict;
+use Carp;
 
-my $copyright = '';
 my $in_sub    = 0;
 my $in_head   = 0;
 my $defined   = 0;
 my $close     = 0;
-my $count     =  0;
+my $count     = 0;
+my $copyright = '';
 my $buf       = '';
 my $prev_argv = '';
 my $prev_line = '';
+my $comment   = '';
+my $reason    = '';
+my $fnf_args  = '';
+my $cur_fn    = '';
 
 while (<>) {
     if (/^\#.*(Copyright.*)/i) {
@@ -22,7 +32,7 @@ while (<>) {
 
     if (/^\#.*\$FML:.*(\d{4})\/\d{2}\/\d{2} /i) {
 	my $year = $1;
-	print "\n$ARGV\n\tcopyright wrong\n" unless $copyright =~ /$year/;
+	print "\n$ARGV\n\twrong copyright\n" unless $copyright =~ /$year/;
     }
 
     # reset the line number counter
@@ -32,6 +42,9 @@ while (<>) {
     }
     $count++;
 
+    # holds comment buf;
+    $comment .= $_ if /^\#/;
+
     if (/^\s*\#/ || /^\s*$/) {
 	$prev_line = $_;
 	next;
@@ -40,8 +53,8 @@ while (<>) {
     # ignore documents
     if (/^\=\w+/) {
 	$prev_line = $_;
-	$in_head = 1;
-	$in_head = 0 if /^\=cut/;
+	$in_head   = 1;
+	$in_head   = 0 if /^\=cut/;
 	next;
     }
     if ($in_head) {
@@ -56,7 +69,8 @@ while (<>) {
     if (/\$\S+\-\>(close|open)/ && (!/^sub /) && (!/^=head/) && (!/\$self/)) {
 	unless ($defined) {
 	    $buf .= " ===> ". $_;
-	    $buf =~ s/\n/\n\t/gm; $buf =~ s/^/\t/;
+	    $buf =~ s/\n/\n\t/gm;
+	    $buf =~ s/^/\t/;
 	    print "\n$ARGV $count {\n\tdefined() ?\n\n", $buf, "\n}\n\n";
 	}
     }
@@ -65,15 +79,24 @@ while (<>) {
     # 
     # 2. check FNF
     # 
-    if (/^sub / && ($prev_line !~ /^\#\s*\w+/)) {
-	print "\n$ARGV $count\n\t(FNF)> $_";
+    if (/^sub /) {
+	unless ( _is_fnf($comment) ) {
+	    print "\n$ARGV $count\n   $_\twrong FNF ($reason)\n";
+	}
+	undef $comment;
+    }
+
+    if ($in_sub && /\@_;\s*$/) {
+	_check_args( $ARGV, $_ );
     }
+    $fnf_args = '' if /^\}/;
 
     # 
     # last resort: logging buffer
     # 
-    if (/^sub |^\}/) {
+    if (/^sub (\S+)|^\}/) {
 	undef $buf;
+	$cur_fn  = $1 . "()";
 	$in_sub  = 1;
 	$defined = 0;
     }
@@ -84,3 +107,128 @@ while (<>) {
 
     $prev_line = $_;
 }
+
+exit 0;
+
+
+# Descriptions: check if $buf matches FNF style.
+#    Arguments: STR($buf)
+# Side Effects: update $reason
+# Return Value: NUM
+sub _is_fnf
+{
+    my ($buf) = @_;
+    my $found = 0;
+    my $is_arg = 0;
+    my %type  = (
+		 "Descriptions" => 0, 
+		 "Arguments"    => 0, 
+		 "Side Effects" => 0, 
+		 "Return Value" => 0, 
+		 );
+    undef $reason;
+
+    # special trap
+    if ($buf =~ /\#\s+Descriptions:\s*\n\#\s+\S+/m) {
+	$found |= 1;
+	$type{ "Descriptions" } = 1;
+    }
+
+    for (split(/\n/, $buf)) {
+	if (/\#\s+Descriptions:\s+\S+/o) { 
+	    $found |= 1;
+	    $type{ "Descriptions" } = 1;
+	    $is_arg = 0;
+	}
+	if (/\#\s+Arguments:\s+\S+/o) { 
+	    $found |= (1 << 1);
+	    $type{ "Arguments" } = 1;
+	    $is_arg = 1;
+	}
+	if (/\#\s+Side Effects:\s+\S+/o) { 
+	    $found |= (1 << 2);
+	    $type{ "Side Effects" } = 1;
+	    $is_arg = 0;
+	}
+	if (/\#\s+Return Value:\s+\S+/o) { 
+	    $found |= (1 << 3);
+	    $type{ "Return Value" } = 1;
+	    $is_arg = 0;
+	}
+
+	# hold argument buffer
+	$fnf_args .= $_ if $is_arg;
+    }
+
+    if ($found == 15) {
+	return 1;
+    }
+    else {
+	for my $key (keys %type) {
+	    unless ($type{ $key }) {
+		$reason .= $reason ? ",$key" : $key;
+	    }
+	}
+
+	if ($found == 0) {
+	    $reason = "no comment lines";
+	}
+
+	return 0;
+    }
+}
+
+
+# Descriptions: check consistency between @_ and FNF Arguments.
+#    Arguments: STR($prog) STR($buf)
+# Side Effects: none
+# Return Value: none
+sub _check_args
+{
+    my ($prog, $buf) = @_;
+    my $fnf = $fnf_args;
+
+    $buf =~ s/^\s*//;
+    $buf =~ s/\s*$//;
+
+    # my ( ... ) = @_;
+    unless ($buf =~ /^my\s*\(/) {
+	print "\n$prog\n   $cur_fn\n\tmissing my()? $buf\n\n";
+	return;
+    }
+
+    $buf =~ s/my\s*\(//;
+    $buf =~ s/\)\s*=.*$//;
+
+    my (@args) = split(/\s*,\s*/, $buf);
+
+    # FNF
+    my (@fnf) = ();
+    $fnf =~ s/\#//g;
+    $fnf =~ s/\n/    /g;
+
+    for (split(/\s+/, $fnf)) {
+	if (/^\w+\((\S+)\)/) {
+	    push(@fnf, $1);
+	}
+    }
+
+    my $bad = 0;
+    if ($#args != $#fnf) {
+	$bad = 1;
+    }
+    else {
+	for (my $i = 0; $i <= $#args; $i++) {
+	    if ($args[ $i ] ne $fnf[ $i ]) {
+		$bad = 1;
+	    }
+	}
+    }
+
+    if ($bad) {
+	print "\n$prog\n   $cur_fn\n\twrong arguments\n";
+	print "\tFNF  @fnf\n";
+	print "\t\@_   @args\n";
+	print "\n";
+    }
+}
diff --git a/regress/style/find_bad_style.pl b/regress/style/find_bad_style.pl
index c33df22a..e6a6e639 100755
--- a/regress/style/find_bad_style.pl
+++ b/regress/style/find_bad_style.pl
@@ -1,19 +1,29 @@
 #!/usr/bin/env perl
+#-*- perl -*-
 #
-# $FML: find_bad_style.pl,v 1.1 2002/06/01 05:06:22 fukachan Exp $
+#  Copyright (C) 2002,2003 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: find_bad_style.pl,v 1.2 2003/01/03 10:16:33 fukachan Exp $
 #
 
 use strict;
+use Carp;
 
-my $copyright = '';
 my $in_sub    = 0;
 my $in_head   = 0;
 my $defined   = 0;
 my $close     = 0;
-my $count     =  0;
+my $count     = 0;
+my $copyright = '';
 my $buf       = '';
 my $prev_argv = '';
 my $prev_line = '';
+my $comment   = '';
+my $reason    = '';
+my $fnf_args  = '';
+my $cur_fn    = '';
 
 while (<>) {
     if (/^\#.*(Copyright.*)/i) {
@@ -22,7 +32,7 @@ while (<>) {
 
     if (/^\#.*\$FML:.*(\d{4})\/\d{2}\/\d{2} /i) {
 	my $year = $1;
-	print "\n$ARGV\n\tcopyright wrong\n" unless $copyright =~ /$year/;
+	print "\n$ARGV\n\twrong copyright\n" unless $copyright =~ /$year/;
     }
 
     # reset the line number counter
@@ -32,6 +42,9 @@ while (<>) {
     }
     $count++;
 
+    # holds comment buf;
+    $comment .= $_ if /^\#/;
+
     if (/^\s*\#/ || /^\s*$/) {
 	$prev_line = $_;
 	next;
@@ -40,8 +53,8 @@ while (<>) {
     # ignore documents
     if (/^\=\w+/) {
 	$prev_line = $_;
-	$in_head = 1;
-	$in_head = 0 if /^\=cut/;
+	$in_head   = 1;
+	$in_head   = 0 if /^\=cut/;
 	next;
     }
     if ($in_head) {
@@ -56,7 +69,8 @@ while (<>) {
     if (/\$\S+\-\>(close|open)/ && (!/^sub /) && (!/^=head/) && (!/\$self/)) {
 	unless ($defined) {
 	    $buf .= " ===> ". $_;
-	    $buf =~ s/\n/\n\t/gm; $buf =~ s/^/\t/;
+	    $buf =~ s/\n/\n\t/gm;
+	    $buf =~ s/^/\t/;
 	    print "\n$ARGV $count {\n\tdefined() ?\n\n", $buf, "\n}\n\n";
 	}
     }
@@ -65,15 +79,24 @@ while (<>) {
     # 
     # 2. check FNF
     # 
-    if (/^sub / && ($prev_line !~ /^\#\s*\w+/)) {
-	print "\n$ARGV $count\n\t(FNF)> $_";
+    if (/^sub /) {
+	unless ( _is_fnf($comment) ) {
+	    print "\n$ARGV $count\n   $_\twrong FNF ($reason)\n";
+	}
+	undef $comment;
+    }
+
+    if ($in_sub && /\@_;\s*$/) {
+	_check_args( $ARGV, $_ );
     }
+    $fnf_args = '' if /^\}/;
 
     # 
     # last resort: logging buffer
     # 
-    if (/^sub |^\}/) {
+    if (/^sub (\S+)|^\}/) {
 	undef $buf;
+	$cur_fn  = $1 . "()";
 	$in_sub  = 1;
 	$defined = 0;
     }
@@ -84,3 +107,128 @@ while (<>) {
 
     $prev_line = $_;
 }
+
+exit 0;
+
+
+# Descriptions: check if $buf matches FNF style.
+#    Arguments: STR($buf)
+# Side Effects: update $reason
+# Return Value: NUM
+sub _is_fnf
+{
+    my ($buf) = @_;
+    my $found = 0;
+    my $is_arg = 0;
+    my %type  = (
+		 "Descriptions" => 0, 
+		 "Arguments"    => 0, 
+		 "Side Effects" => 0, 
+		 "Return Value" => 0, 
+		 );
+    undef $reason;
+
+    # special trap
+    if ($buf =~ /\#\s+Descriptions:\s*\n\#\s+\S+/m) {
+	$found |= 1;
+	$type{ "Descriptions" } = 1;
+    }
+
+    for (split(/\n/, $buf)) {
+	if (/\#\s+Descriptions:\s+\S+/o) { 
+	    $found |= 1;
+	    $type{ "Descriptions" } = 1;
+	    $is_arg = 0;
+	}
+	if (/\#\s+Arguments:\s+\S+/o) { 
+	    $found |= (1 << 1);
+	    $type{ "Arguments" } = 1;
+	    $is_arg = 1;
+	}
+	if (/\#\s+Side Effects:\s+\S+/o) { 
+	    $found |= (1 << 2);
+	    $type{ "Side Effects" } = 1;
+	    $is_arg = 0;
+	}
+	if (/\#\s+Return Value:\s+\S+/o) { 
+	    $found |= (1 << 3);
+	    $type{ "Return Value" } = 1;
+	    $is_arg = 0;
+	}
+
+	# hold argument buffer
+	$fnf_args .= $_ if $is_arg;
+    }
+
+    if ($found == 15) {
+	return 1;
+    }
+    else {
+	for my $key (keys %type) {
+	    unless ($type{ $key }) {
+		$reason .= $reason ? ",$key" : $key;
+	    }
+	}
+
+	if ($found == 0) {
+	    $reason = "no comment lines";
+	}
+
+	return 0;
+    }
+}
+
+
+# Descriptions: check consistency between @_ and FNF Arguments.
+#    Arguments: STR($prog) STR($buf)
+# Side Effects: none
+# Return Value: none
+sub _check_args
+{
+    my ($prog, $buf) = @_;
+    my $fnf = $fnf_args;
+
+    $buf =~ s/^\s*//;
+    $buf =~ s/\s*$//;
+
+    # my ( ... ) = @_;
+    unless ($buf =~ /^my\s*\(/) {
+	print "\n$prog\n   $cur_fn\n\tmissing my()? $buf\n\n";
+	return;
+    }
+
+    $buf =~ s/my\s*\(//;
+    $buf =~ s/\)\s*=.*$//;
+
+    my (@args) = split(/\s*,\s*/, $buf);
+
+    # FNF
+    my (@fnf) = ();
+    $fnf =~ s/\#//g;
+    $fnf =~ s/\n/    /g;
+
+    for (split(/\s+/, $fnf)) {
+	if (/^\w+\((\S+)\)/) {
+	    push(@fnf, $1);
+	}
+    }
+
+    my $bad = 0;
+    if ($#args != $#fnf) {
+	$bad = 1;
+    }
+    else {
+	for (my $i = 0; $i <= $#args; $i++) {
+	    if ($args[ $i ] ne $fnf[ $i ]) {
+		$bad = 1;
+	    }
+	}
+    }
+
+    if ($bad) {
+	print "\n$prog\n   $cur_fn\n\twrong arguments\n";
+	print "\tFNF  @fnf\n";
+	print "\t\@_   @args\n";
+	print "\n";
+    }
+}