#!/usr/bin/perl
#$Id: test_rig_conf.pl,v 1.9 2024/09/17 08:55:40 sqko Exp $
use strict;
use warnings;
use RFC::Main;
use RFC::Rig;

my $rig = shift;
exit unless ($rig && $rig =~ /\d/);

my $nr = 3;
print "Writing script for rig $rig\n";
my $r = RFC::Rig->new($rig);
my @l = $r->test_list();
$nr += @l;

my $file = 'test.t';
open MYOUT,'>',$file or die "Could not open file $file for writing $!\n";
print MYOUT "#!/usr/bin/perl\n";

print MYOUT "use Test::Simple tests=>$nr;\n";
print MYOUT "use RFC::Rig;\n";
print MYOUT 'print "###########   Testing rig '.$rig.' #########\n";',"\n";
print MYOUT '$r = RFC::Rig->new(',$rig,');',"\n";
print MYOUT "ok(defined(\$r) && ref(\$r) eq 'RFC::Rig','new() works for rig $rig');\n";
print MYOUT "ok(\$r->error eq '','Init returned no errors');\n";
print MYOUT "\n";
print MYOUT 'my @list = $r->test_list();',"\n";
print MYOUT 'foreach my $item (@list)',"\n";
print MYOUT "{\n";
print MYOUT "    eval {\n";
print MYOUT '         ok(test_func($$item{"id"}->test_full(),$$item{"id"}),$$item{"name"});',"\n";
print MYOUT "    };\n";
print MYOUT "    if (\$\@)\n";
print MYOUT "    {\n";
print MYOUT "         print \"ERROR: Test for \$\$item{'name'} died!\";\n";
print MYOUT "         print \$\@;\n";
print MYOUT "    }\n";
print MYOUT "}\n";
print MYOUT 'my @l = split(/[\s\t]+/,$r->readstring());',"\n";
print MYOUT 'ok(@l%4 == 0,"Redstring contains modulo 4 rows!");',"\n";
print MYOUT '$r->DESTROY();',"\n";
print MYOUT "\n";
print MYOUT <<END;

sub test_func()
{
    my \$t = shift;
    my \$i = shift;
    if (!\$t)
    {
        print \$i->print_config(),\"\\n\";
    }
    return \$t;
}

END

close MYOUT;

system("/usr/bin/perl $file");
unlink $file if (-e $file);
