#!/usr/bin/perl -w
# make test program skeleton

use strict;
use Common;


my $file = $ARGV[0];

if ( !defined($file) || ! -f $file || $file !~ m/\.pm$/ ) {
    print "Usage: mktest.pl <file>\nwhere <file> must be a perl module (with .pm extension)\n";
    exit 0;
}

my @line = Common::read_file($file);
$file =~ s/\.pm$//;

my $state = 0;
my @func;
my %para;
my %prot;
my $func;
for my $line (@line) {
    if ($state == 0) {
	# skip to sub xxx()
	if ($line =~ m/^sub ([^(]*)\((.*)\)/) {
	    $func = $1;
	    my $arg = $2;
	    $arg =~ tr/; \r\n\f\t//d;
	    push @func, $func;
	    if ($arg) {
		$para{$func} = [];
		$prot{$func} = [ split(//, $arg) ];
		$state = 1;
	    } else {
		$state = 2;
	    }
	    #print "$func\n";
	}
    } elsif ($state == 1) {
	if ($line =~ m/^}$/) {
	    $func = undef;
	    $state = 0;
	} elsif ($line =~ m/^\s*#/ || $line =~ m/^\s*$/) {
	} elsif ($line =~ m/([\$@%][a-zA-Z0-9_]+)\s+=\s+(shift|@)/) {
	    my $id = $1;
	    push @{$para{$func}}, $id;
	    #print " $id\n"
	} else {
	    $state = 2;
	}
    } elsif ($state == 2) {
	if ($line =~ m/^}$/) {
	    $func = undef;
	    $state = 0;
	}
    } elsif ($state == 3) {
    } elsif ($state == 4) {
    } elsif ($state == 5) {
    }
}
my $A = "";
my $B = "";
for my $func (@func) {
    $A .= "\$disp{$func} = [ \\&t$func, \"test $func\" ];\n";
    $B .= "
sub t$func(\$) {
  my \@fld = split(\$_);
";
    my $pr = $para{$func};
    my $ar = $prot{$func};
    my $str = "";
    if (defined($pr)) {
	my @para = @$pr;
	my @prot;
	if (defined($ar)) { @prot = @$ar; }
	for (my $ix = 0; $ix < @para; $ix++) {
	    my $id = $para[$ix];
	    my $ad = $prot[$ix];
	    if (defined($ad)) {
		my $type = substr($id,0,1);
		# variable type vs. prototype type
		# $ vx. $ ok, 
		if (
		    ($type eq '$' && $ad eq '$') ||
		    ($type eq '$' && $ad eq '&') ||
		    ($type eq '@' && $ad eq '@') ||
		    ($type eq '%' && $ad eq '@') ||
		    ($type eq '%' && $ad eq '%')
		) {
		    # ok.
		} else {
		    warn("$func: <$id> <$ad>");
		}
	    }
	    if ($id =~ /^\$/) {
		$B .= "  my $id = shift \@fld;\n";
	    } else {
		$B .= "  my $id = \@fld;\n";
	    }
	}
	if (@para) {
	    $str = join(", ", @para);
	} else {
	    $str = "\@fld";
	}
    }
    $B .= "
  my \@res = $file\::$func($str);
  print \"<\", join(\"> <\", \@res), \">\\n\";
}
";
}

print '#!/usr/bin/perl -w

use strict;
use test;
';
print "use $file;

my \%disp;
";

print $A;
print $B;
print "\ntest::main(\%disp);\n";