Re: [svn:parrot] r19183 - in trunk: languages/m4/lib/Parrot/Test languages/plumhead/lib/Parrot/Test languages/plumhead/lib/Parrot/Test/Plumhead lib/Parrot On Wednesday 20 June 2007 12:39:08 bernhard@cvs.perl.org wrote:
> Modified: trunk/lib/Parrot/Test.pm> ===========================================================================>=== --- trunk/lib/Parrot/Test.pmÂ Â Â Â (original)> +++ trunk/lib/Parrot/Test.pmÂ Â Â Â Wed Jun 20 12:39:06 2007
> @@ -411,6 +412,76 @@> Â  Â  Â return $path;> Â }> Â > +> +# These functions are only used by various> +# Parrot::Test:: modules.> +# See RT#43266> +# This implementation is experimental and currently only works> +# for languages/plumhead> +sub generate_languages_functions {> +> + Â  Â my %test_map = (> + Â  Â  Â  Â output_is Â  => 'is_eq',> + Â  Â  Â  Â output_like => 'like',> + Â  Â  Â  Â output_isnt => 'isnt_eq'> + Â  Â );> +> + Â  Â foreach my $func ( keys %test_map ) {> + Â  Â > + Â  Â  Â  Â my $test_sub = sub {> + Â  Â  Â  Â  Â  Â my $self = shift;> + Â  Â  Â  Â  Â  Â my ( $code, $output, $desc, %options ) = @_;> + Â  Â > + Â  Â  Â  Â  Â  Â my $count = $self->{builder}->current_test() + 1;> + Â  Â > + Â  Â  Â  Â  Â  Â # These are the thing that depend on the actual language> implementation + Â  Â  Â  Â  Â  Â my $out_fn Â  Â = $self->get_out_fn( $count, Â > Â \\%options ); + Â  Â  Â  Â  Â  Â my $lang_fn Â  = $self->get_lang_fn( $count, Â > Â \\%options ); + Â  Â  Â  Â  Â  Â my @test_prog = $self->get_test_prog( $count,> \\%options ); +> + Â  Â  Â  Â  Â  Â Parrot::Test::write_code_to_file( $code, $lang_fn );> + Â  Â > + Â  Â  Â  Â  Â  Â # set a TODO 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(> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â \\@test_prog,> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â CD Â  Â  => $self->{relpath},> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â STDOUT => $out_fn,> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â STDERR => $out_fn> + Â  Â  Â  Â  Â  Â  Â  Â );> + Â  Â > + Â  Â  Â  Â  Â  Â  Â  Â my $meth = $test_map{$func};> + Â  Â > + Â  Â  Â  Â  Â  Â  Â  Â # That's the reason for: Â  no strict 'refs';> + Â  Â  Â  Â  Â  Â  Â  Â my $pass = $self->{builder}->$meth(> Parrot::Test::slurp_file($out_fn), $output, $desc ); + Â  Â  Â  Â  Â  Â  Â 
That line works under strict 'refs'; all method lookups are symbolic in Perl 5.
> Â unless ($pass) {> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â my $diag = '';> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â my $test_prog = join ' && ', @test_prog;> + Â  Â  Â  Â  Â  Â  Â  Â  Â  Â $diag .= "'$test_prog' failed with exit code> $exit_code." if $exit_code; + Â  Â  Â  Â  Â  Â  Â  Â  Â > Â $self->{builder}->diag($diag) if $diag;> + Â  Â  Â  Â  Â  Â  Â  Â }> + Â  Â  Â  Â  Â  Â }
I think this code eats segfaults, as per RT #39197.
There's a lot of opportunity for refactoring and cleanup in the Parrot::Test modules.  There's too much duplication as it is.
-- c

