Permalink
Browse files

[punie] move from Parrot tree

  • Loading branch information...
1 parent 7ccfb08 commit fda2e597313d727f7c20f23b51e4b2a137c8c763 @fperrad fperrad committed Mar 9, 2009
Showing with 75 additions and 0 deletions.
  1. +75 −0 t/Parrot/Test/Punie.pm
View
@@ -0,0 +1,75 @@
+# $Id: Punie.pm 37201 2009-03-08 12:07:48Z fperrad $
+
+# Copyright (C) 2005-2007, Parrot Foundation.
+
+package Parrot::Test::Punie;
+
+use strict;
+use warnings;
+
+use File::Basename;
+use File::Spec ();
+
+=head1 NAME
+
+Parrot::Test::Punie -- testing routines for languages/punie
+
+This is largely a copy of Parrot::Test::Tcl, which looks like it's
+largely a copy of Parrot::Test::Python. Abstraction needed.
+
+=cut
+
+sub new {
+ return bless {};
+}
+
+sub output_is {
+ my ( $self, $code, $output, $desc ) = @_;
+
+ my $count = $self->{builder}->current_test + 1;
+
+ my $lang_f = Parrot::Test::per_test( '.p1', $count );
+ my $out_f = Parrot::Test::per_test( '.out', $count );
+ my $parrotdir = dirname $self->{parrot};
+
+ my $args = $ENV{TEST_PROG_ARGS} || '';
+
+ $lang_f = File::Spec->rel2abs($lang_f);
+ $out_f = File::Spec->rel2abs($out_f);
+ Parrot::Test::write_code_to_file( $code, $lang_f );
+
+ my $cmd;
+ my $exit_code = 0;
+ my $pass = 0;
+
+ $cmd = "$self->{parrot} $args languages/punie/punie.pbc $lang_f";
+
+ $exit_code = Parrot::Test::run_command(
+ $cmd,
+ CD => $self->{relpath},
+ STDOUT => $out_f,
+ STDERR => $out_f
+ );
+ unless ($pass) {
+ my $file = Parrot::Test::slurp_file($out_f);
+ $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($out_f), $output, $desc );
+ $self->{builder}->diag("'$cmd' failed with exit code $exit_code")
+ if $exit_code and not $pass;
+ }
+
+ unless ( $ENV{POSTMORTEM} ) {
+ unlink $lang_f;
+ unlink $out_f;
+ }
+
+ return $pass;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

0 comments on commit fda2e59

Please sign in to comment.