Run with
perl -Mlib=lib t/harness
Tests live in t/*/*.t .
In case of failure the assembler, bytecode and output
are available as t/dir/testnnn.pasm/pbc/out
tested under Linux and Win32
Regards
Mattia
--patch--
diff -r -b -u -2 -N parrot.cvs/lib/Test/Parrot.pm
parrot/lib/Test/Parrot.pm
--- parrot.cvs/lib/Test/Parrot.pm Thu Jan 01 01:00:00 1970
+++ parrot/lib/Test/Parrot.pm Thu Sep 13 19:01:16 2001
@@ -0,0 +1,79 @@
+#
+
+package Test::Parrot;
+
+use strict;
+use vars qw(@EXPORT @ISA);
+
+require Exporter;
+require Test::More;
+
+@EXPORT = ( qw(output_is), @Test::More::EXPORT );
+@ISA = qw(Exporter Test::More);
+
+sub import {
+ my( $class, $plan, @args ) = @_;
+
+ Test::More->import( $plan, @args );
+
+ __PACKAGE__->_export_to_level( 2, __PACKAGE__ );
+}
+
+# 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 "$^X -e \"$redir_string;system qq{$command};\"";
+}
+
+my $count;
+
+foreach my $i ( qw(is isnt like) ) {
+ no strict 'refs';
+
+ *{"Test::Parrot::output_$i"} = sub ($$;$) {
+ ++$count;
+ my( $assembly, $output, $desc ) = @_;
+ local( *ASSEMBLY, *OUTPUT );
+ my( $as_f, $by_f, $out_f ) = map {
+ my $t = $0; $t =~ s/\.t$/$count\.$_/; $t
+ } ( qw(pasm pbc 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;
+
+ @_ = ( $prog_output, $output, $desc );
+ #goto &{"Test::More::$i"};
+ my $ok = &{"Test::More::$i"}( @_ );
+ unlink( $by_f, $out_f ) if $ok;
+ }
+}
+
+1;
+
diff -r -b -u -2 -N parrot.cvs/t/harness parrot/t/harness
--- parrot.cvs/t/harness Thu Jan 01 01:00:00 1970
+++ parrot/t/harness Thu Sep 13 17:36:08 2001
@@ -0,0 +1,7 @@
+#! perl -w
+
+use strict;
+use Test::Harness qw(runtests);
+
+my @tests = map { glob( "t/$_/*.t" ) } ( qw(op misc) );
+runtests( @tests );
diff -r -b -u -2 -N parrot.cvs/t/op/basic.t parrot/t/op/basic.t
--- parrot.cvs/t/op/basic.t Thu Jan 01 01:00:00 1970
+++ parrot/t/op/basic.t Fri Sep 14 01:42:44 2001
@@ -0,0 +1,32 @@
+#! perl -w
+
+use Test::Parrot tests => 1;
+
+ok( 1 );
+exit 0;
+
+output_is( <<CODE, <<OUTPUT, "branch_ic" );
+ set_i_ic I4, 42
+ branch_ic HERE
+ set_i_ic I4, 1234
+HERE:
+ print_i I4
+ end
+CODE
+I reg 4 is 42
+OUTPUT
+
+SKIP: {
+ skip( "label constants unimplemented in assembler", 1 );
+output_is( <<CODE, <<OUTPUT, "jump" );
+ set_i_ic I4, 42
+ set_i_ic I5, HERE
+ jump_i I5
+ set_i_ic I4, 1234
+HERE:
+ print_i I4
+ end
+CODE
+I reg 4 is 42
+OUTPUT
+}
diff -r -b -u -2 -N parrot.cvs/t/op/string.t parrot/t/op/string.t
--- parrot.cvs/t/op/string.t Thu Jan 01 01:00:00 1970
+++ parrot/t/op/string.t Fri Sep 14 01:58:28 2001
@@ -0,0 +1,56 @@
+#! perl -w
+
+use Test::Parrot tests => 4;
+
+output_is( <<'CODE', <<OUTPUT, "set_s_sc" );
+ set S4, "JAPH\n"
+ print S4
+ end
+CODE
+JAPH
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "length_i_s" );
+ set I4, 0
+ set S4, "JAPH"
+ length I4, S4
+ print I4
+ set S3, "\n"
+ print S3
+ end
+CODE
+4
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "chopn_s_ic" );
+ set S4, "JAPHxyzw"
+ set S5, "japhXYZW"
+ set S3, "\n"
+ chopn S4, 3
+ chopn S4, 1
+ chopn S5, 4
+ print S4
+ print S3
+ print S5
+ print S3
+ end
+CODE
+JAPH
+japh
+OUTPUT
+
+SKIP: {
+ skip "I'm unable to write it!", 1;
+output_is( <<'CODE', <<OUTPUT, "substr_s_s_i_i" );
+ set S4, "12345JAPH01"
+ set I4, 5
+ set I5, 4
+ substr S5, S4, I4, I5
+ print S5
+ set S3, "\n"
+ print S3
+ end
+CODE
+JAPH
+OUTPUT
+}
--end patch--
------- End of forwarded message -------
------- End of forwarded message -------
