Hi all,
Here's a patch for discussion. It adds a new test module that uses a Parrot
embedded in Perl 5 to run pir_output_*() tests. It's a bit fragile and
depends on Embed::Parrot (which I haven't checked in yet). I'm just posting
it here to document that it exists and works in some cases, and to get any
feedback.
I'll post my concrete, enumerated questions about checkin in Embed::Parrot in
a separate message.
-- c
=== MANIFEST
==================================================================
--- MANIFEST (revision 19697)
+++ MANIFEST (local)
@@ -1912,6 +1912,7 @@
lib/Parrot/Pmc2c/Library.pm [devel]
lib/Parrot/Revision.pm [devel]
lib/Parrot/Test.pm [devel]
+lib/Parrot/Test/Embedded.pm [devel]
lib/Parrot/Test/APL.pm [devel]
lib/Parrot/Test/Cardinal.pm [devel]
lib/Parrot/Test/Harness.pm [devel]
=== lib/Parrot/Test/Embedded.pm
==================================================================
--- lib/Parrot/Test/Embedded.pm (revision 19697)
+++ lib/Parrot/Test/Embedded.pm (local)
@@ -0,0 +1,168 @@
+# Copyright (C) 2006, The Perl Foundation.
+# $Id: /parrotcode/offline/lib/Parrot/Test.pm 19147 2006-07-18T05:35:26.358659Z chromatic $
+
+=head1 NAME
+
+Parrot::Test::Embedded - Parrot testing routines with embedded Parrot
+
+=head1 SYNOPSIS
+
+Set the number of tests to run:
+
+ use Parrot::Test::Embedded tests => 8;
+
+Write individual tests:
+
+ pir_output_is(<<'CODE', <<'OUTPUT', "description of test");
+ .sub main :main
+ print "this is ok\n"
+ end
+ CODE
+ this is ok
+ OUTPUT
+
+For now, you must name the main code C<main>, lest bad things happen and
+everyone get sick. When the embedding interface improves, this may be less
+necessary.
+
+=head1 DESCRIPTION
+
+This module provides a faster, possibly stricter version of the PIR-running
+Parrot-specific test functions. It also uses the remaining test functions from
+Parrot::Test, so don't fret.
+
+=cut
+
+package Parrot::Test::Embedded;
+
+use strict;
+use warnings;
+
+use Cwd;
+use Data::Dumper;
+
+use Parrot::Test;
+use Parrot::Config;
+use Parrot::Embed;
+
+require Exporter;
+require Test::Builder;
+require Test::More;
+
+our @EXPORT = qw( plan run_command skip slurp_file );
+
+use base qw( Exporter );
+
+# tell parrot it's being tested--disables searching of installed libraries.
+# (see Parrot_get_runtime_prefix in src/library.c).
+$ENV{PARROT_TEST} = 1 unless defined $ENV{PARROT_TEST};
+
+my $builder = Test::Builder->new();
+my $parent = Parrot::Embed::create_interpreter( 0 );
+
+sub import {
+ my ($class, $plan, @args) = @_;
+
+ $builder->plan( $plan, @args );
+
+ __PACKAGE__->export_to_level( 2, __PACKAGE__ );
+}
+
+# We can inherit from Test::More, so we do it.
+*plan = \&Test::More::plan;
+*skip = \&Test::More::skip;
+
+#
+# private methods, should not be used by Modules inherition from Parrot::Test
+#
+
+sub _generate_functions {
+ my $package = 'Parrot::Test::Embedded';
+
+ my %parrot_test_map = (
+ pir_output_is => 'is_eq',
+ pir_output_isnt => 'isnt_eq',
+ pir_output_like => 'like',
+ );
+
+ for my $func ( keys %parrot_test_map ) {
+ push @EXPORT, $func;
+ no strict 'refs';
+
+ *{$package.'::'.$func} = sub {
+ local $SIG{__WARN__} = \&report_odd_hash;
+ my( $code, $expected, $desc, %extra) = @_;
+
+ $code .= <<TEST_HEADER;
+.namespace
+
+.sub _test_it
+ .local pmc pio
+ pio = getstdout
+ push pio, "string"
+
+ main()
+
+ .local string output
+ output = read pio, 2048
+
+ .local string layer
+ pop layer, pio
+
+ .return( output )
+.end
+TEST_HEADER
+
+ # set up default description
+ unless ( $desc ) {
+ (undef, my $file, my $line) = caller();
+ $desc = "($file line $line)";
+ }
+
+ my $interp = Parrot::Embed::create_interpreter( $parent );
+ Parrot::Embed::compile_string( $interp, $code )
+ or die "Compile error\n";
+ my $sub = Parrot::Embed::find_global( $interp, '_test_it' );
+ die "test sub not found\n" unless $sub + 0;
+ my $out_pmc = Parrot::Embed::call_sub( $interp, $sub, 'PV', '' );
+ die "no output found\n" unless $out_pmc + 0;
+ my $output = Parrot::Embed::get_string_from_pmc($interp, $out_pmc);
+
+ # set a TODO for Test::Builder to find
+ my $call_pkg = $builder->exported_to() || '';
+ # die Dumper( $code, $expected, $desc, \%extra, $extra{todo}, $call_pkg ) if ( keys %extra );
+ local *{ $call_pkg . '::TODO' } = \$extra{todo}
+ if defined $extra{todo};
+
+ my $meth = $parrot_test_map{$func};
+
+ return $builder->$meth( $output, $expected, $desc );
+ };
+ }
+}
+
+Parrot::Test::Embedded::_generate_functions();
+
+=head1 SEE ALSO
+
+=over 4
+
+=item F<t/harness>
+
+=item F<docs/tests.pod>
+
+=item L<Test/More>
+
+=item L<Test/Builder>
+
+=item L<Parrot/Embed>
+
+=item L<Parrot/Test>
+
+=back
+
+=cut
+
+1;
+
+# vim: expandtab sw=4
