*** empty log message ***

[coreutils.git] / tests / ls-2 / T.pm

package T;

require 5.004;
use strict;
use vars qw($VERSION @ISA @EXPORT);

use FileHandle;
use File::Compare qw(compare);

@ISA = qw(Exporter);
$VERSION = '0.5';
@EXPORT = qw (run_tests);

my @Types = qw (IN OUT ERR EXIT);
my %Types = map {$_ => 1} @Types;
my %Zero_one_type = map {$_ => 1} qw (OUT ERR EXIT);

my $Global_count = 1;

sub _create_file ($$$$$)
{
  my ($program_name, $test_name, $type, $file_name, $data) = @_;
  my $file;
  if (defined $file_name)
    {
      $file = $file_name;
    }
  else
    {
      $file = "$test_name-$$.$Global_count";
      ++$Global_count;
    }

  # The test spec gave a string.
  # Write it to a temp file and return tempfile name.
  #warn "writing $type `$data' to $file\n";
  my $fh = new FileHandle "> $file";
  die "$program_name: $file: $!\n" if ! $fh;
  print $fh $data;
  $fh->close || die "$program_name: $file: $!\n";

  return $file;
}

# FIXME: cleanup on interrupt
# FIXME: extract `do_1_test' function

# FIXME: having to include $program_name here is an expedient kludge.
# Library code doesn't `die'.
sub run_tests ($$$$$)
{
  my ($program_name, $prog, $t_spec, $save_temps, $verbose) = @_;

  # Warn about empty t_spec.
  # FIXME

  # Remove all temp files upon interrupt.
  # FIXME

  # Verify that test names are distinct.
  my $found_duplicate = 0;
  my %seen;
  my $t;
  foreach $t (@$t_spec)
    {
      my $test_name = $t->[0];
      if ($seen{$test_name})
        {
          warn "$program_name: $test_name: duplicate test name\n";
          $found_duplicate = 1;
        }
      $seen{$test_name} = 1;
    }
  return 1 if $found_duplicate;

  # FIXME check exit status
  system ($prog, '--version');

  my @junk_files;
  my $fail = 0;
  foreach $t (@$t_spec)
    {
      my $test_name = shift @$t;
      my $expect = {};

      $Global_count = 1;
      my @args;
      my $io_spec;
      my %seen_type;
      foreach $io_spec (@$t)
        {
          if (!ref $io_spec)
            {
              push @args, $io_spec;
              next;
            }

          die "$program_name: $test_name: invalid test spec\n"
            if ref $io_spec ne 'HASH';

          my $n = keys %$io_spec;
          die "$program_name: $test_name: spec has $n elements --"
            . " expected 1\n"
              if $n != 1;
          my ($type, $val) = each %$io_spec;
          die "$program_name: $test_name: invalid key `$type' in test spec\n"
            if ! $Types{$type};

          # Make sure there's no more than one of OUT, ERR, EXIT.
          die "$program_name: $test_name: more than one $type spec\n"
            if $Zero_one_type{$type} and $seen_type{$type}++;

          if ($type eq 'EXIT')
            {
              # FIXME: make sure $data is numeric
              $expect->{EXIT} = $val;
              next;
            }

          my $file_spec = $val;
          my ($file_name, $contents);
          if (!ref $file_spec)
            {
              ($file_name, $contents) = (undef, $file_spec);
            }
          elsif (ref $file_spec eq 'HASH')
            {
              my $n = keys %$file_spec;
              die "$program_name: $test_name: $type spec has $n elements --"
                . " expected 1\n"
                  if $n != 1;
              ($file_name, $contents) = each %$file_spec;
            }
          else
            {
              die "$program_name: $test_name: invalid RHS in $type-spec\n"
            }

          my $is_junk_file = (! defined $file_name);
          my $file = _create_file ($program_name, $test_name, $type,
                                   $file_name, $contents);
          if ($type eq 'IN')
            {
              push @args, $file
            }
          else
            {
              $expect->{$type} = $file;
            }

          if ($is_junk_file)
            {
              push @junk_files, $file
            }
          else
            {
              # FIXME: put $srcdir in here somewhere
              warn "$program_name: $test_name: specified file `$file' does"
                . " not exist\n"
                  if ! -f $file;
            }
        }

      # Expect an exit status of zero if it's not specified.
      $expect->{EXIT} ||= 0;

      # Allow ERR to be omitted -- in that case, expect no error output.
      my $eo;
      foreach $eo (qw (ERR OUT))
        {
          if (!exists $expect->{$eo})
            {
              $expect->{$eo} = _create_file ($program_name, $test_name, $eo,
                                             undef, '');
              push @junk_files, $expect->{$eo};
            }
        }

      # FIXME: Require at least one of OUT_DATA, OUT_FILE.  Why?

      warn "$test_name...\n";
      my $t_out = "$test_name-out";
      my $t_err = "$test_name-err";
      push (@junk_files, $t_out, $t_err);
      my @cmd = ($prog, @args, "> $t_out", "2> $t_err");
      my $cmd_str = join (' ', @cmd);
      warn "Running command: `$cmd_str'\n" if $verbose;
      my $rc = 0xffff & system $cmd_str;
      if ($rc == 0xff00)
        {
          warn "$program_name: test $test_name failed: command failed:\n"
            . "  `$cmd_str': $!\n";
          $fail = 1;
          next;
        }
      $rc >>= 8 if $rc > 0x80;
      if ($expect->{EXIT} != $rc)
        {
          warn "$program_name: test $test_name failed: exit status mismatch:"
            . "  expected $expect->{EXIT}, got $rc\n";
          $fail = 1;
          next;
        }

      if (compare ($expect->{OUT}, $t_out))
        {
          warn "$program_name: stdout mismatch, comparing"
            . " $expect->{OUT} and $t_out\n";
          $fail = 1;
          next;
        }
      if (compare ($expect->{ERR}, $t_err))
        {
          warn "$program_name: stderr mismatch, comparing"
            . " $expect->{ERR} and $t_err\n";
          $fail = 1;
          next;
        }
    }

  unlink @junk_files if ! $save_temps;

  return $fail;
}

## package return
1;