[svn:parrot] r40582 - in trunk: . lib/Parrot t/tools
dukeleto at svn.parrot.org
dukeleto at svn.parrot.org
Sun Aug 16 06:30:12 UTC 2009
Author: dukeleto
Date: Sun Aug 16 06:30:09 2009
New Revision: 40582
URL: https://trac.parrot.org/parrot/changeset/40582
Log:
[TT #101] Add tests for pbc_disassemble and pbc_dump, with a convenience function in Parrot::Test
Thanks to rurban++ for the original patch
Added:
trunk/t/tools/pbc_disassemble.t
trunk/t/tools/pbc_dump.t
Modified:
trunk/MANIFEST
trunk/lib/Parrot/Test.pm
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Sun Aug 16 05:37:16 2009 (r40581)
+++ trunk/MANIFEST Sun Aug 16 06:30:09 2009 (r40582)
@@ -2087,6 +2087,8 @@
t/tools/ops2pm/samples/ops_num.original [test]
t/tools/ops2pm/samples/pic_ops.original [test]
t/tools/parrot_debugger.t [test]
+t/tools/pbc_disassemble.t [test]
+t/tools/pbc_dump.t [test]
t/tools/pbc_merge.t [test]
t/tools/pgegrep.t [test]
t/tools/pmc2c.t [test]
Modified: trunk/lib/Parrot/Test.pm
==============================================================================
--- trunk/lib/Parrot/Test.pm Sun Aug 16 05:37:16 2009 (r40581)
+++ trunk/lib/Parrot/Test.pm Sun Aug 16 06:30:09 2009 (r40582)
@@ -275,7 +275,7 @@
require Test::Builder;
require Test::More;
-our @EXPORT = qw( plan run_command skip slurp_file);
+our @EXPORT = qw( plan run_command skip slurp_file pbc_postprocess_output_like );
use base qw( Exporter );
@@ -492,6 +492,59 @@
}
}
+=over
+
+=item "pbc_postprocess_output_like"
+
+Takes a path to binary which will post process PBC, a file to run, the extension
+of the file, one regex or an array reference of regexes, and an optional
+diagnostic message. This function generates PBC for the input file, then post
+processes this with the binary and captures the output. The output is then
+verified to match the single or multiple regular expressions given.
+
+ my $postprocess = File::Spec->catfile( ".", "pbc_dump" );
+ my $file = 'foo.pir';
+ my $ext = 'pir';
+ my $check = [ qr/has a foo/, qr/and a bar/ ];
+ pbc_postprocess_output_like ( $postprocess,
+ $file, $ext, $check,
+ "checking pbc_dump"
+ );
+
+=back
+
+=cut
+
+sub pbc_postprocess_output_like {
+ my ( $postprocess, $file, $ext, $check, $diag ) = @_;
+ my $testno = $builder->current_test() + 1;
+ my $codefn = "$0.$testno.$ext";
+ my $pbcfn = "$0.$testno.pbc";
+ my $stdoutfn = "$0.$testno.stdout";
+ my $f = IO::File->new(">$codefn");
+ my $parrot = File::Spec->catfile( ".", $PConfig{test_prog} );
+ $f->print($file);
+ $f->close();
+ system("$parrot -o $pbcfn $codefn 2>&1");
+ system("$postprocess $pbcfn >$stdoutfn 2>&1");
+ $f = IO::File->new($stdoutfn);
+
+ my $output = join( '', <$f> );
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ unlink ($codefn, $pbcfn, $stdoutfn);
+ if (ref $check eq 'ARRAY') {
+ for my $regex (@$check) {
+ Test::More::like( $output, $regex, $diag );
+ $testno++;
+ }
+ }
+ else {
+ Test::More::like( $output, $check, $diag );
+ }
+
+}
+
# The following methods are private. They should not be used by modules
# inheriting from Parrot::Test.
Added: trunk/t/tools/pbc_disassemble.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/tools/pbc_disassemble.t Sun Aug 16 06:30:09 2009 (r40582)
@@ -0,0 +1,106 @@
+#! perl
+# Copyright (C) 2009, The Perl Foundation.
+# $Id$
+
+=head1 NAME
+
+t/tools/pbc_disassemble.t - test the Parrot Bytecode (PBC) Disassembler
+
+=head1 SYNOPSIS
+
+ % prove t/tools/pbc_disassemble.t
+
+=head1 DESCRIPTION
+
+Tests the C<pbc_disassemble> tool by providing it with a number of source
+files, and running through it with various commands.
+
+We never actually check the I<full> output of pbc_disassemble. We simply check
+several smaller components to avoid a test file that is far too unwieldy.
+
+
+=head1 REQUIREMENTS
+
+This test script requires you to build pbc_disassemble, by typing
+"make parrot_utils" (using a suitable make tool for your platform).
+If this requirement has not been met, all tests will be skipped.
+
+=cut
+
+use strict;
+use warnings;
+use lib qw(lib);
+
+use Test::More;
+use IO::File ();
+use Parrot::Config;
+use File::Spec;
+use Parrot::Test;
+
+my $path;
+
+BEGIN {
+ $path = File::Spec->catfile( ".", "pbc_disassemble" );
+ my $exefile = $path . $PConfig{exe};
+ unless ( -f $exefile ) {
+ plan skip_all => "pbc_disassemble hasn't been built. Run make parrot_utils";
+ exit(0);
+ }
+ plan tests => 4;
+}
+
+disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*set_n_nc.*print_n/ms, 'pbc_disassemble numeric ops');
+.sub main :main
+ \$N3 = 3.14159
+ print \$N3
+ print "\\n"
+.end
+PIR
+
+disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*set_i_ic.*print_i/ms, 'pbc_disassemble integer ops');
+.sub main :main
+ \$I0 = 1982
+ print \$I0
+ print "\\n"
+.end
+PIR
+
+disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*new_p_sc.*"ResizablePMCArray".*set_p_kic_ic\s*P.*set_i_p_kic\s*I.*/ms, 'pbc_disassemble pmc ops');
+.sub main :main
+ \$P0 = new 'ResizablePMCArray'
+ \$P0[0] = 42
+ \$I0 = \$P0[0]
+.end
+PIR
+
+disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*set_s_sc\s*S.*print_s\s*S.*print_sc/ms, 'pbc_disassemble string ops');
+.sub main :main
+ \$S0 = "Wheels within wheels"
+ print \$S0
+ print "\\n"
+.end
+PIR
+
+=head1 HELPER SUBROUTINES
+
+=head2 disassemble_output_like
+
+ disassemble_output_like(<<PASM, "pasm", "some output", "running $file");
+
+Takes 3-4 arguments: a file to run,
+the filename-extension of the file (probably "pir" or "pasm"),
+an arrayref or single regex string to match within pbc_disassemble's output,
+and the optional test diagnostic.
+
+=cut
+
+sub disassemble_output_like {
+ pbc_postprocess_output_like($path, @_ );
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Added: trunk/t/tools/pbc_dump.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/tools/pbc_dump.t Sun Aug 16 06:30:09 2009 (r40582)
@@ -0,0 +1,82 @@
+#! perl
+# Copyright (C) 2009, The Perl Foundation.
+# $Id$
+
+=head1 NAME
+
+t/tools/pbc_dump.t - test the Parrot Bytecode (PBC) Dumper
+
+=head1 SYNOPSIS
+
+ % prove t/tools/pbc_dump.t
+
+=head1 DESCRIPTION
+
+Tests the C<pbc_dump> tool by providing it with a number of source
+files, and running through it with various commands.
+
+We never actually check the I<full> output of pbc_dump. We simply check
+several smaller components to avoid a test file that is far too unwieldy.
+
+
+=head1 REQUIREMENTS
+
+This test script requires you to build pbc_dump, by typing
+"make parrot_utils" (using a suitable make tool for your platform).
+If this requirement has not been met, all tests will be skipped.
+
+=cut
+
+use strict;
+use warnings;
+use lib qw(lib);
+
+use Test::More;
+use IO::File ();
+use Parrot::Config;
+use Parrot::Test;
+use File::Spec;
+
+my $path;
+
+BEGIN {
+ $path = File::Spec->catfile( ".", "pbc_dump" );
+ my $exefile = $path . $PConfig{exe};
+ unless ( -f $exefile ) {
+ plan skip_all => "pbc_dump hasn't been built. Run make parrot_utils";
+ exit(0);
+ }
+ plan tests => 4;
+}
+
+dump_output_like( <<PIR, "pir", [qr/FIXUP_t/, qr/PIC_idx/, qr/CONSTANT_t/, qr/BYTECODE_t/], 'pbc_dump numeric');
+.sub main :main
+ \$N3 = 3.14159
+ print \$N3
+ print "\\n"
+.end
+PIR
+
+=head1 HELPER SUBROUTINES
+
+=head2 dump_output_like
+
+ dump_output_like(<<PASM, "pasm", "some output", "running $file");
+
+Takes 3-4 arguments: a file to run,
+the filename-extension of the file (probably "pir" or "pasm"),
+an arrayref or single regex string to match within pbc_dump's output,
+and the optional test diagnostic.
+
+=cut
+
+sub dump_output_like {
+ pbc_postprocess_output_like($path, @_ );
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list