Test ( was: Re: Things we need to do. )

[Mattia Barbon]

> If you're looking for something to do, we *always* have good
> little jobs for people. :)
Great!

>     6) A test suite! My kingdom for a test suite!
I had a first stab at it; attached module + sample script,
for discussion only, because it is a kludge; I'll tidy it up
this evening.

Questions: 
* what other functions are required?
* where should tests reside? ( t/op/*.t, t/misc/*.t, etc? )
* where should helper perl5 modules go?
  ( lib/Test/Parrot.pm ? )

To Schwern:
* Test::Parrot ( or whatever ), needs to be special cased
  in Test::Simple::ok ( as Test::More is ), to report test
  line correctly.

Regards
Mattia



use strict;

use lib 'lib';
use Test::Parrot;

Test::Parrot::output_is( <<TEST, <<OUTPUT );
        set_s_sc S1, "Hello World"
        print_s S1
        print_s S1
TEST
S reg 1 is Hello World
S reg 1 is Hello World
OUTPUT

#

package Test::Parrot;

require File::Spec;
use Test::More qw(no_plan);

use strict;

# this kludge is an hopefully portable way of having
# redirections ( tested on Linux and Win2k )
sub _run_command {
  my( $command, %redir ) = @_;
  my( $redir_string );

  while( my @dup = each %redir ) {
    my( $from, $to ) = @dup;
    if( $to eq 'STDERR' ) { $to = "qq{>&STDERR}" }
    elsif( $to eq 'STDOUT' ) { $to = "qq{>&STDOUT}" }
    elsif( $to eq '/dev/null' ) { $to = ( $^O eq 'MSWin32' ) ?
                                      'qq{> NUL:}' : "qq{> $to}" }
    else { $to = "qq{> $to}" }

    $redir_string .= "open $from, $to;"
  }

  system "perl -e \"$redir_string;system qq{$command};\"";
}

sub output_is($$) {
  my( $assembly, $output ) = @_;
  local( *ASSEMBLY, *OUTPUT );
  my( $as_f, $by_f, $out_f ) = qw(test.pasm test.pbc test.out);

  open ASSEMBLY, "> $as_f" or die "Unable to open '$as_f'";
  binmode ASSEMBLY;
  print ASSEMBLY $assembly;
  close ASSEMBLY;

  _run_command( "perl assemble.pl $as_f", 'STDOUT' => $by_f );
  _run_command( "./test_prog $by_f", 'STDOUT' => $out_f );

  my $prog_output;
  open OUTPUT, "< $out_f";
  {
    local $/ = undef;
    $prog_output = <OUTPUT>;
  }
  close OUTPUT;

  Test::More::is( $prog_output, $output );
}

1;