Author: bernhard
Date: Sun Mar 19 05:21:01 2006
New Revision: 11935
Modified:
trunk/lib/Parrot/Test.pm
trunk/t/benchmark/benchmarks.t
trunk/t/examples/japh.t
Log:
Added the subs example_output_like() and example_output_like()
to Parrot::Test. However these subs are not used anywhere yet,
as they are broken with regard to the 'todo' flag.
Modified: trunk/lib/Parrot/Test.pm
==============================================================================
--- trunk/lib/Parrot/Test.pm (original)
+++ trunk/lib/Parrot/Test.pm Sun Mar 19 05:21:01 2006
@@ -151,6 +151,16 @@
Determine the language from the extension of C<$example_fn> and
runs language_output_is().
+=item C<example_output_like( $example_fn, $expected )>
+
+Determine the language from the extension of C<$example_fn> and
+runs language_output_like().
+
+=item C<example_output_isnt( $example_fn, $expected )>
+
+Determine the language from the extension of C<$example_fn> and
+runs language_output_isnt().
+
=item C<skip($why, $how_many)>
Use within a C<SKIP: { ... }> block to indicate why and how many test
@@ -194,20 +204,19 @@
require Test::More;
[EMAIL PROTECTED] = qw(
[EMAIL PROTECTED] = qw( c_output_is c_output_like c_output_isnt
+ example_output_is example_output_like example_output_like
language_output_is language_output_like language_output_isnt
- example_output_is
output_is output_like output_isnt
pasm_output_is pasm_output_like pasm_output_isnt
+ pbc_output_is pbc_output_like pbc_output_isnt
past_output_is past_output_like past_output_isnt
pir_output_is pir_output_like pir_output_isnt
pir_2_pasm_is pir_2_pasm_like pir_2_pasm_isnt
- pbc_output_is pbc_output_like pbc_output_isnt
- c_output_is c_output_like c_output_isnt
plan
+ run_command
skip
slurp_file
- run_command
);
@ISA = qw(Exporter);
@@ -543,6 +552,40 @@
}
}
+ # XXX this is broken WRT todo tests
+ my %example_test_map = (
+ example_output_is => 'language_output_is',
+ example_output_like => 'language_output_like',
+ example_output_isnt => 'language_output_isnt',
+ );
+
+ foreach my $func ( keys %example_test_map ) {
+ no strict 'refs';
+
+ *{$package.'::'.$func} = sub ($$;@) {
+ my ($example_fn, $expected, @options) = @_;
+
+ my %lang_for_extension
+ = ( pasm => 'PASM',
+ past => 'PAST',
+ pir => 'PIR',
+ imc => 'PIR', );
+
+ my ( $extension ) = $example_fn =~ m{ [.]
# introducing extension
+ ( pasm | pir | imc | past )
# match and capture the extension
+ \z
# at end of string
+ }ixms or Usage();
+ if ( defined $extension ) {
+ my $code = slurp_file($example_fn);
+ my $test_func = join( '::', $package, $example_test_map{$func}
);
+ $test_func->( $lang_for_extension{$extension}, $code,
$expected, $example_fn, @options );
+ }
+ else {
+ fail( defined $extension, "no extension recognized for
$example_fn" );
+ }
+ }
+ }
+
my %c_test_map = (
c_output_is => 'is_eq',
c_output_isnt => 'isnt_eq',
@@ -641,28 +684,6 @@
}
}
-sub example_output_is {
- my ($example_fn, $expected, @options) = @_;
-
- my %lang_for_extension
- = ( pasm => 'PASM',
- past => 'PAST',
- pir => 'PIR',
- imc => 'PIR', );
-
- my ( $extension ) = $example_fn =~ m{ [.] #
introducing extension
- ( pasm | pir | imc | past ) # match
and capture the extension
- \z # at end
of string
- }ixms or Usage();
- if ( defined $extension ) {
- my $code = slurp_file($example_fn);
- language_output_is( $lang_for_extension{$extension}, $code, $expected,
$example_fn, @options );
- }
- else {
- fail( defined $extension, "no extension recognized for $example_fn" );
- }
-}
-
Parrot::Test::_generate_functions(__PACKAGE__, \&generate_code );
=head1 TODO
Modified: trunk/t/benchmark/benchmarks.t
==============================================================================
--- trunk/t/benchmark/benchmarks.t (original)
+++ trunk/t/benchmark/benchmarks.t Sun Mar 19 05:21:01 2006
@@ -23,7 +23,6 @@
=cut
-
# Expected output from scripts in 'examples/benchmarks'.
# The expected out is needed for checking results with pir_output_is() and
pir_output_like().
my %outputs = (
@@ -215,7 +214,6 @@
q{stress3.pasm} => 'Null PMC access in
get_integer()',
);
-
plan tests => scalar keys %outputs;
foreach ( sort keys %outputs ) {
@@ -226,6 +224,13 @@
my @todo = $todo{$_} ? ( todo => $todo{$_} ) : ();
# XXX use example_output_is() and example_output_like()
+ # This does not work yet WRT to TODO
+ # if ( ref $outputs{$_} eq 'Regexp' ) {
+ # example_output_like( "examples/benchmarks/$_", $outputs{$_},
@todo );
+ # }
+ # else {
+ # example_output_is( "examples/benchmarks/$_", $outputs{$_}, @todo
);
+ # }
if ( ref $outputs{ $_ } eq q(Regexp) ) {
if ( /\.pasm$/ ) {
pasm_output_like( $bench, $outputs{ $_ }, $_, @todo );
Modified: trunk/t/examples/japh.t
==============================================================================
--- trunk/t/examples/japh.t (original)
+++ trunk/t/examples/japh.t Sun Mar 19 05:21:01 2006
@@ -15,7 +15,7 @@
=head1 SYNOPSIS
- % prove t/examples/japh.t
+ % prove t/examples/japh.t
=head1 DESCRIPTION
@@ -64,7 +64,7 @@
# local $TODO = $todo{$_};
skip $todo{$_}, 1;
- example_output_is($pasm_fn, "Just another Parrot Hacker\n");
+ example_output_is( $pasm_fn, "Just another Parrot Hacker\n" );
};
} else {
example_output_is($pasm_fn, "Just another Parrot Hacker\n");
