t/examples/shootout.t

   1 #!perl
   2 # Copyright (C) 2005-2006, The Perl 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 -Cj")
  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 =head1 SEE ALSO
  47
  48 #40064: [TODO] shootout example testing in Parrot RT
  49
  50 L<"https://rt.perl.org/rt3/Public/Bug/Display.html?id=40064">
  51
  52 =cut
  53
  54 my %skips = (
  55     'pidigits.pir'    => [ 'not exists $PConfig{HAS_GMP}', 'needs GMP' ],
  56     'recursive.pir'   => [ '$PConfig{cpuarch} !~ /86/',    'float JIT broken on non-x86' ],
  57     'recursive-2.pir' => [ '$PConfig{cpuarch} !~ /86/',    'float JIT broken on non-x86' ],
  58     'fannkuch.pir'    => [ '$^O eq "darwin"',              'fannkuch benchmark failure on darwin' ],
  59 );
  60 my $INPUT_EXT = '_input';
  61 foreach my $script (@shootouts) {
  62     my $skip = $skips{$script};
  63     if ($skip) {
  64         my ( $cond, $reason ) = @{$skip};
  65         if ( eval "$cond" ) {
  66             Test::More->builder->skip("$script $reason");
  67             next;
  68         }
  69     }
  70     my $file = "$DIR/$script";
  71
  72     # parse first line
  73     open( my $FILE, '<', $file ) or die "unable to open file [$file] : $!";
  74     my $shebang = <$FILE>;
  75     close $FILE;
  76     my $expected = slurp_file("$file$EXT");
  77
  78     my $args = "";
  79     if ( $shebang =~ /^\#.+parrot\s+(.+)$/ ) {
  80         $args = $1;    # parrot options
  81     }
  82     unless ( $PConfig{jitcapable} ) {
  83         $args =~ s/-j/-C/;
  84         $args =~ s/-Cj/-C/;
  85     }
  86     unless ( $PConfig{cg_flag} =~ /HAVE/ ) {
  87         $args =~ s/-Cj/-j/;
  88
  89         # Remove any plain -C option.
  90         $args =~ s/(^|\s)-C(\s|$)/$1$2/;
  91
  92         # Remove any extra Cs still floating around
  93         $args =~ s/C//;
  94     }
  95
  96     # look for input files
  97     my $input = "$file$INPUT_EXT";
  98     if ( -e $input ) {
  99         $args .= " < $input ";
 100     }
 101
 102     $ENV{TEST_PROG_ARGS} = $args;
 103     warn "$file $args\n" if $ENV{TEST_VERBOSE};
 104     my @todo;
 105
 106     # this is an example of todo syntax
 107     # @todo = ( todo => 'known GC segfault' ) if $file =~ /regexdna.pir/;
 108     example_output_is( $file, $expected, @todo );
 109 }
 110
 111 # Local Variables:
 112 #   mode: cperl
 113 #   cperl-indent-level: 4
 114 #   fill-column: 100
 115 # End:
 116 # vim: expandtab shiftwidth=4: