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")
  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 );
  51 my $INPUT_EXT = '_input';
  52 foreach my $script (@shootouts) {
  53     my $skip = $skips{$script};
  54     if ($skip) {
  55         my ( $cond, $reason ) = @{$skip};
  56         if ( eval "$cond" ) {
  57             Test::More->builder->skip("$script $reason");
  58             next;
  59         }
  60     }
  61     my $file = "$DIR/$script";
  62
  63     # parse first line
  64     open( my $FILE, '<', $file ) or die "unable to open file [$file] : $!";
  65     my $shebang = <$FILE>;
  66     close $FILE;
  67     my $expected = slurp_file("$file$EXT");
  68
  69     my $args = "";
  70     if ( $shebang =~ /^\#.+parrot\s+(.+)$/ ) {
  71         $args = $1;    # parrot options
  72     }
  73     unless ( $PConfig{jitcapable} ) {
  74         $args =~ s/-j/-C/;
  75         $args =~ s/-Cj/-C/;
  76     }
  77     $args =~ s/-Cj/-j/;
  78
  79     # Remove any plain -C option.
  80     $args =~ s/(^|\s)-C(\s|$)/$1$2/;
  81
  82     # Remove any extra Cs still floating around
  83     $args =~ s/C//;
  84
  85     # look for input files
  86     my $input = "$file$INPUT_EXT";
  87     if ( -e $input ) {
  88         $args .= " < $input ";
  89     }
  90
  91     $ENV{TEST_PROG_ARGS} = $args;
  92     warn "$file $args\n" if $ENV{TEST_VERBOSE};
  93     my @todo;
  94
  95     # this is an example of todo syntax
  96     # @todo = ( todo => 'known GC segfault' ) if $file =~ /regexdna.pir/;
  97     example_output_is( $file, $expected, @todo );
  98 }
  99
 100 # Local Variables:
 101 #   mode: cperl
 102 #   cperl-indent-level: 4
 103 #   fill-column: 100
 104 # End:
 105 # vim: expandtab shiftwidth=4: