Author: jkeenan
Date: Fri Dec 5 16:49:38 2008
New Revision: 33528
Modified:
branches/testparrottest/lib/Parrot/Test.pm
branches/testparrottest/t/perl/Parrot_Test.t
Log:
1. Move sub generate_languages_functions() farther down in file for ease of
editing. (We'll probably move this out of this package eventually, as it
pertains only to languages built on Parrot, and not to PASM, PIR or C.)
2. Throw in some print STDERR statements to facilitate debugging in
_run_test_file and related unit tests.
Modified: branches/testparrottest/lib/Parrot/Test.pm
==============================================================================
--- branches/testparrottest/lib/Parrot/Test.pm (original)
+++ branches/testparrottest/lib/Parrot/Test.pm Fri Dec 5 16:49:38 2008
@@ -162,92 +162,8 @@
return Cwd::realpath( $path );
}
-sub generate_languages_functions {
-
- my %test_map = (
- output_is => 'is_eq',
- error_output_is => 'is_eq',
- output_like => 'like',
- error_output_like => 'like',
- output_isnt => 'isnt_eq',
- error_output_isnt => 'isnt_eq',
- );
-
- foreach my $func ( keys %test_map ) {
-
- my $test_sub = sub {
- local *__ANON__ = $func;
- my $self = shift;
- my ( $code, $expected, $desc, %options ) = @_;
-
- # set a todo-item for Test::Builder to find
- my $call_pkg = $self->{builder}->exported_to() || '';
-
- no strict 'refs';
-
- local *{ $call_pkg . '::TODO' } = ## no critic
Variables::ProhibitConditionalDeclarations
- \$options{todo}
- if defined $options{todo};
-
- my $count = $self->{builder}->current_test() + 1;
-
- # These are the thing that depend on the actual language
implementation
- my $out_f = $self->get_out_fn( $count, \%options );
- my $lang_f = $self->get_lang_fn( $count, \%options );
- my $cd = $self->get_cd( \%options );
- my @test_prog = $self->get_test_prog( $count, \%options );
-
- Parrot::Test::write_code_to_file( $code, $lang_f );
-
- # set a todo-item for Test::Builder to find
- my $skip_why = $self->skip_why( \%options );
- if ($skip_why) {
- $self->{builder}->skip($skip_why);
- }
- else {
-
- # STDERR is written into same output file
- my $exit_code = Parrot::Test::run_command(
- [EMAIL PROTECTED],
- CD => $cd,
- STDOUT => $out_f,
- STDERR => $out_f
- );
- my $real_output = slurp_file($out_f);
-
- if ( $func =~ m/^ error_/xms ) {
- return _handle_error_output( $self->{builder},
$real_output, $expected, $desc )
- unless $exit_code;
- }
- elsif ($exit_code) {
- $self->{builder}->ok( 0, $desc );
-
- my $test_prog = join ' && ', @test_prog;
- $self->{builder}->diag("'$test_prog' failed with exit code
$exit_code.");
-
- return 0;
- }
-
- my $meth = $test_map{$func};
- $self->{builder}->$meth( $real_output, $expected, $desc );
- }
-
- # The generated files are left in the t/* directories.
- # Let 'make clean' and 'svn:ignore' take care of them.
-
- return;
- };
-
- my ($package) = caller();
-
- no strict 'refs';
-
- *{ $package . '::' . $func } = $test_sub;
- }
-}
-
-# The following methods are private.
-# They should not be used by modules inheriting from Parrot::Test.
+# The following methods --up until generate_languages_functions() -- are
+# private. They should not be used by modules inheriting from Parrot::Test.
sub _handle_error_output {
my ( $builder, $real_output, $expected, $desc ) = @_;
@@ -265,6 +181,13 @@
sub _run_test_file {
local $SIG{__WARN__} = \&_report_odd_hash;
my ( $func, $code, $expected, $desc, %extra ) = @_;
+my $incoming_desc_status;
+if ($desc) {
+ $incoming_desc_status++;
+ print STDERR "desc: $desc\n";
+} else {
+ print STDERR "desc is Perl-false\n";
+}
my $path_to_parrot = path_to_parrot();
my $parrot = File::Spec->join( File::Spec->curdir(), 'parrot' .
$PConfig{exe} );
@@ -277,6 +200,11 @@
( undef, my $file, my $line ) = caller();
$desc = "($file line $line)";
}
+if ($desc) {
+ print STDERR "desc: $desc\n";
+} else {
+ print STDERR "desc is still Perl-false\n";
+}
# $test_no will be part of temporary file
my $test_no = $builder->current_test() + 1;
@@ -854,6 +782,90 @@
return;
}
+sub generate_languages_functions {
+
+ my %test_map = (
+ output_is => 'is_eq',
+ error_output_is => 'is_eq',
+ output_like => 'like',
+ error_output_like => 'like',
+ output_isnt => 'isnt_eq',
+ error_output_isnt => 'isnt_eq',
+ );
+
+ foreach my $func ( keys %test_map ) {
+
+ my $test_sub = sub {
+ local *__ANON__ = $func;
+ my $self = shift;
+ my ( $code, $expected, $desc, %options ) = @_;
+
+ # set a todo-item for Test::Builder to find
+ my $call_pkg = $self->{builder}->exported_to() || '';
+
+ no strict 'refs';
+
+ local *{ $call_pkg . '::TODO' } = ## no critic
Variables::ProhibitConditionalDeclarations
+ \$options{todo}
+ if defined $options{todo};
+
+ my $count = $self->{builder}->current_test() + 1;
+
+ # These are the thing that depend on the actual language
implementation
+ my $out_f = $self->get_out_fn( $count, \%options );
+ my $lang_f = $self->get_lang_fn( $count, \%options );
+ my $cd = $self->get_cd( \%options );
+ my @test_prog = $self->get_test_prog( $count, \%options );
+
+ Parrot::Test::write_code_to_file( $code, $lang_f );
+
+ # set a todo-item for Test::Builder to find
+ my $skip_why = $self->skip_why( \%options );
+ if ($skip_why) {
+ $self->{builder}->skip($skip_why);
+ }
+ else {
+
+ # STDERR is written into same output file
+ my $exit_code = Parrot::Test::run_command(
+ [EMAIL PROTECTED],
+ CD => $cd,
+ STDOUT => $out_f,
+ STDERR => $out_f
+ );
+ my $real_output = slurp_file($out_f);
+
+ if ( $func =~ m/^ error_/xms ) {
+ return _handle_error_output( $self->{builder},
$real_output, $expected, $desc )
+ unless $exit_code;
+ }
+ elsif ($exit_code) {
+ $self->{builder}->ok( 0, $desc );
+
+ my $test_prog = join ' && ', @test_prog;
+ $self->{builder}->diag("'$test_prog' failed with exit code
$exit_code.");
+
+ return 0;
+ }
+
+ my $meth = $test_map{$func};
+ $self->{builder}->$meth( $real_output, $expected, $desc );
+ }
+
+ # The generated files are left in the t/* directories.
+ # Let 'make clean' and 'svn:ignore' take care of them.
+
+ return;
+ };
+
+ my ($package) = caller();
+
+ no strict 'refs';
+
+ *{ $package . '::' . $func } = $test_sub;
+ }
+}
+
=head1 SEE ALSO
=over 4
Modified: branches/testparrottest/t/perl/Parrot_Test.t
==============================================================================
--- branches/testparrottest/t/perl/Parrot_Test.t (original)
+++ branches/testparrottest/t/perl/Parrot_Test.t Fri Dec 5 16:49:38 2008
@@ -30,7 +30,7 @@
plan( skip_all => "Test::Builder::Tester not installed\n" );
exit 0;
}
- plan( tests => 96 );
+ plan( tests => 97 );
}
use lib qw( . lib ../lib ../../lib );
@@ -479,15 +479,20 @@
like($stdout, qr/$text/, "Captured STDOUT");
is($exit_message, 0, "Got 0 as exit message");
}
+undef $out;
+undef $err;
+undef $chdir;
-#$desc = '';
-#pasm_output_is( <<'CODE', <<'OUTPUT', $desc );
-# print "foo\n"
-# end
-#CODE
-#foo
-#OUTPUT
-##test_test($desc);
+
+$desc = '';
+test_out("ok 1 - $desc");
+pasm_output_is( <<'CODE', <<'OUTPUT', $desc );
+ print "foo\n"
+ end
+CODE
+foo
+OUTPUT
+test_test($desc);
# Local Variables:
# mode: cperl
