Converting DejaGNU tests to Paul's test/assert infrastructure

[David Bateman]

Dear All,

I've written a perl script over the weekend that attempts to 
automatically convert the DejaGNU scripts into scripts usable with 
Paul's test/assert infrastructure. It seems to work well in the cases 
I've currently tested it against (definitely not all of them). However I 
have a particular problem with the test/octave.test/args DejaGNU tests. 
These tests are of the form

1;
function [varargout] = f (varargin)
printf ("nargin: %d, nargout: %d\n", nargin, nargout);
endfunction
[s, t, u, v] = f (1, 2, 3);

and the DejaGNU expected result is

set test args-10
set prog_output "nargin: 3, nargout: 4"
do_test args-10.m

The only fashion I see of converting this test is something like

%!test
%! global nout nin;
%! function [varargout] = f (varargin)
%!   global nout, nin;
%!   nout = nargout; nin = nargin;
%! endfunction
%! [s, t, u, v] = f (1, 2, 3);
%! assert(nout,4);
%! assert(nin,3);

However, nested functions are not permitted with Paul's test 
infrastructure. I haven't looked at test.m yet to see, but how 
complicated would it be to include nested functions in test.m?

Another issue I have is that although "%!error" exists there is no 
equivalent "%!warning" for the warning conditions. Again how complicated 
would it be to add this?

In any case I include my perl script to convert the DejaGNU files. It 
can be run something like

cd octave/
mkdir new_test
convert_test ./test ./new_test

I make no promises to the quality of the code and it certainly isn't 
complete, and some of the code is converted incorrectly.However, it 
addresses the vast majority of the existing tests and converts them 
automatically, and works particularly well against "arith.exp" and 
"matrix.exp" that I used to write this script against.

Regards
David

--
David Bateman                                address@hidden
Motorola Labs - Paris                        +33 1 69 35 48 04 (Ph) 
Parc Les Algorithmes, Commune de St Aubin    +33 1 69 35 77 01 (Fax) 
91193 Gif-Sur-Yvette FRANCE

The information contained in this communication has been classified as: 

[x] General Business Information 
[ ] Motorola Internal Use Only 
[ ] Motorola Confidential Proprietary

#! /usr/bin/perl

use strict;
use File::Find;
use File::Basename;
use Text::Wrap;
use FileHandle;
use IPC::Open3;

my $in_dir = @ARGV[0];
my $out_dir = @ARGV[1];

# locate all *.exp files in $in_dir
my @exp_files = ();
find(\&exp_files_in_dir, $in_dir);

sub exp_files_in_dir { # {{{1 populates global array @exp_files
    return unless -f and /\.(exp)$/;  # .exp files
    my $path = "$File::Find::dir/$_";
    $path =~ s|^[.]/||;
    push @exp_files, $path;
} # 1}}}

foreach my $fexp ( @exp_files ) {
  my $fbase = basename($fexp,('.exp'));
  my $fdir = dirname($fexp);
  die "Null DejaGNU expect file?? [$fexp]\n" unless $fbase;
  my $fout = sprintf("%s/%s.m", $out_dir, $fbase);

  if (open(OUT,">$fout")) {
    print OUT "%% Automatically generated from DejaGNU files\n\n";
    if (open(IN,$fexp)) {
      print STDOUT "Converting $fexp to $fout\n";
      if ($fbase =~ /^args$/) {
        # Special case for the args.exp tests. Need global variables
        while (<IN>) {
          # Look for line of the form /^set test [a-zA-Z].*/ to identify
          # the test
          next unless /^set test [a-zA-Z].*/;
          # Identify output of the test
          my $test = <IN>;
          $test =~ s/^set prog_output "(.*)"$/$1/;
          my $nargin = $test;
          $nargin =~ s/^nargin: (.*), nargout: .*$/$1/;
          $nargin =~ s/\s*\n//;
          my $nargout = $test;
          $nargout =~ s/^nargin: .*, nargout: (.*)$/$1/;
          $nargout =~ s/\s*\n//;
          my $mtest = <IN>;
          $mtest =~ s/do_test //;
          $mtest =~ s/\s*\n//;
          $mtest = sprintf("%s/%s", $fdir, $mtest);
          print OUT "%% $mtest\n";
          print OUT "%!test\n";
          print OUT "%! global nin nout;\n";
          if (open(MIN,$mtest)) {
            while (<MIN>) {
              next if /^1;$/;
              if (/printf/) {
                print OUT "%!   global nin nout;\n";
                print OUT "%!   nout = nargout; nin = nargin;\n";
              } else {
                print OUT "%! $_";
              }
            }
            print OUT "%! assert(nin,$nargin);\n";
            print OUT "%! assert(nout,$nargout);\n\n";
          }
        }
      } else {
        while (<IN>) {
          # Look for line of the form /^set test [a-zA-Z].*/ to identify
          # the test
          next unless /^set test [a-zA-Z].*/;
          # Identify output of the test
          my $test = <IN>;
          $test =~ s/^set prog_output "(.*)"$/$1/;
          # Is the output an error message
          if ($test =~ /^\^usage/ || $test =~ /^\\n\.\.\. .*:\.\*$/ ||
              $test =~ /^\^error/ || $test =~ /^parse error/) {
            my $mtest = <IN>;
            $mtest =~ s/do_test //;
            $mtest =~ s/\s*\n//;
            $mtest = sprintf("%s/%s", $fdir, $mtest);
            print OUT "%% $mtest\n";
            if (open(MIN,$mtest)) {
              my $line = <MIN>;
              $line =~ s/^\s*//;
              $line =~ s/\s*\n$//;
              while (<MIN>) {
                s/^\s*//;
                s/\s*\n$//;
                $line .= $_;
              }
              if ($line =~ /;/) {
                print OUT "%!error(eval('$line'));\n\n";
              } else {
                print OUT "%!error($line);\n\n";
              }
              close (MIN);
            } else {
              print STDERR "Could not open test file ($mtest): $!\n";
            }
          } elsif ($test =~ /^\^*[a-zA-Z][a-zA-Z0-9]* = [^;]*$/) {
            my $var = $test;
            $var =~ s/^\^*([a-zA-Z][a-zA-Z0-9]*) = .*\n$/$1/;
            my $val = $test;
            $val =~ s/^\^ans = (.*)$/$1/;
            $val =~ s/\n//;
            my $mtest = <IN>;
            $mtest =~ s/do_test //;
            $mtest =~ s/\s*\n//;
            $mtest = sprintf("%s/%s", $fdir, $mtest);
            print OUT "%% $mtest\n";
            if (open(MIN,$mtest)) {
              my $line = <MIN>;
              $line =~ s/^\s*//;
              $line =~ s/\s*\n$//;
              if ($line !~ /\;$/) {
                while (<MIN>) {
                  s/^\s*//;
                  s/\s*\n$//;
                  $line = sprintf("%s\n%! %s", $line, $_);
                  last if ($line =~ /\;$/);
                }
              }
              if ($line =~ /\;$/) {
                print OUT "%!test\n";
                print OUT "%! $line\n";
                while ($line = <MIN>) {
                  $line =~ s/^\s*//;
                  $line =~ s/\s*\n$//;
                  if ($line !~ /\;$/) {
                    while (<MIN>) {
                      s/^\s*//;
                      s/\s*\n$//;
                      $line = sprintf("%s\n%! %s", $line, $_);
                      last if ($line =~ /\;$/);
                    }
                  }
                  if ($line =~ /\;$/) {
                    print OUT "%! $line\n";
                  }
                  last unless ($line =~ /\;$/);
                }
                if ($line =~ /any\s*\(/ || $line =~ /all\s*\(/ ||
                    $line =~ /\&\&/ || $line =~ /\|\|/) {
                  if ($val =~ /^1$/) {
                    if ($var !~ /^ans$/) {
                      print OUT "%! $line;\n";
                      print OUT "%! assert($var);\n\n";
                    } else {
                      print OUT "%! assert($line);\n\n";
                    }
                  } else {
                    if ($var !~ /^ans$/) {
                      print OUT "%! $line;\n";
                      print OUT "%! assert(!($var));\n\n";
                    } else {
                      print OUT "%! assert(!($line));\n\n";
                    }
                  }
                } else {
                  if ($var !~ /^ans$/) {
                    print OUT "%! $line;\n";
                    print OUT "%! assert($var,$val);\n\n";
                  } else {
                    print OUT "%! assert($line,$val);\n\n";
                  }
                }
              } else {
                if ($line =~ /any\s*\(/ || $line =~ /all\s*\(/ ||
                    $line =~ /\&\&/ || $line =~ /\|\|/) {
                  if ($val =~ /^1$/) {
                    if ($var !~ /^ans$/) {
                      print OUT "%!test\n%! $line;\n";
                      print OUT "%! assert($var);\n\n";
                    } else {
                      print OUT "%!assert($line);\n\n";
                    }
                  } else {
                    if ($var !~ /^ans$/) {
                      print OUT "%!test\n%! $line;\n";
                      print OUT "%! assert(!($var));\n\n";
                    } else {
                      print OUT "%!assert(!($line));\n\n";
                    }
                  }
                } else {
                  if ($var !~ /^ans$/) {
                    print OUT "%!test\n%! $line;\n";
                    print OUT "%! assert($var,$val);\n\n";
                  } else {
                    print OUT "%!assert($line,$val);\n\n";
                  }
                }
              }
              close(MIN);
            } else {
              print STDERR "Could not open test file ($mtest): $!\n";
            }
          } else {
            $test =~ s/\n$//;
            print STDERR "Can't yet use the test ($test)\n";
          }
        }
      }
      close (IN);
    } else {
      print STDERR "Could not open file ($fexp): $!\n";
    }
    close (OUT);
  } else {
    print STDERR "Could not open file ($fout): $!\n";
  }
}