t/examples/shootout.t

   1 #!perl
   2 # Copyright (C) 2005-2008, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Config;
  10 use vars qw($EXT $DIR @shootouts);
  11
  12 # find dynamically all shootouts from dir listing
  13 BEGIN {    # to be run before declaring the number of tests
  14     $EXT = '_output';
  15     $DIR = "examples/shootout";
  16     opendir( DIR, $DIR ) or die "can't opendir $DIR: $!";
  17     @shootouts = grep { -e "$DIR/$_$EXT" } sort grep { /\.pir$/ } readdir(DIR);
  18     closedir DIR;
  19 }
  20
  21 use Parrot::Test tests => scalar(@shootouts);
  22
  23 =head1 NAME
  24
  25 t/examples/shootout.t - Test the shootout examples in "examples/shootout/*.pir".
  26
  27 =head1 SYNOPSIS
  28
  29     % prove t/examples/shootout.t
  30
  31 =head1 DESCRIPTION
  32
  33 Test the PIR shootout examples in 'examples/shootout/*.pir'.
  34
  35 To add a new test, you do not have to modify this script:
  36
  37  1. add your script (toto.pir) to examples/shootout
  38  2. put parrot options in the first line (e.g  "#!./parrot -Oc -R cgp-jit")
  39  3. make sure you have default argument values
  40  4. put the expected output as a file : toto.pir_output
  41  5. if you need an input file (to be read from stdin), call it toto.pir_input
  42
  43 See the explanation of benchmarks and sample data for reduced N benches at
  44 http://shootout.alioth.debian.org/sandbox/
  45
  46 =cut
  47
  48 my %skips = (
  49     'pidigits.pir'    => [ 'not exists $PConfig{HAS_GMP}', 'needs GMP' ],
  50     'recursive.pir'   => [ '$PConfig{cpuarch} !~ /86/',    'float JIT broken on non-x86' ],
  51     'recursive-2.pir' => [ '$PConfig{cpuarch} !~ /86/',    'float JIT broken on non-x86' ],
  52     'revcomp.pir'     => [ '1',              'string buffering segfault, TT #445' ],
  53 );
  54 my $INPUT_EXT = '_input';
  55 foreach my $script (@shootouts) {
  56     my $skip = $skips{$script};
  57     if ($skip) {
  58         my ( $cond, $reason ) = @{$skip};
  59         if ( eval "$cond" ) {
  60             Test::More->builder->skip("$script $reason");
  61             next;
  62         }
  63     }
  64     my $file = "$DIR/$script";
  65
  66     # parse first line
  67     open( my $FILE, '<', $file ) or die "unable to open file [$file] : $!";
  68     my $shebang = <$FILE>;
  69     close $FILE;
  70     my $expected = slurp_file("$file$EXT");
  71
  72     my $args = "";
  73     if ( $shebang =~ /^\#.+parrot\s+(.+)$/ ) {
  74         $args = $1;    # parrot options
  75     }
  76     unless ( $PConfig{jitcapable} ) {
  77         $args =~ s/-j/-C/;
  78         $args =~ s/-Cj/-C/;
  79     }
  80     unless ( $PConfig{cg_flag} =~ /HAVE/ ) {
  81         $args =~ s/-Cj/-j/;
  82
  83         # Remove any plain -C option.
  84         $args =~ s/(^|\s)-C(\s|$)/$1$2/;
  85
  86         # Remove any extra Cs still floating around
  87         $args =~ s/C//;
  88     }
  89
  90     # look for input files
  91     my $input = "$file$INPUT_EXT";
  92     if ( -e $input ) {
  93         $args .= " < $input ";
  94     }
  95
  96     $ENV{TEST_PROG_ARGS} = $args;
  97     warn "$file $args\n" if $ENV{TEST_VERBOSE};
  98     my @todo;
  99
 100     # this is an example of todo syntax
 101     # @todo = ( todo => 'known GC segfault' ) if $file =~ /regexdna.pir/;
 102     example_output_is( $file, $expected, @todo );
 103 }
 104
 105 # Local Variables:
 106 #   mode: cperl
 107 #   cperl-indent-level: 4
 108 #   fill-column: 100
 109 # End:
 110 # vim: expandtab shiftwidth=4: