lib/Parrot/Test/Harness.pm

   1 # Copyright (C) 2006-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 Parrot::Test::Harness - a test harness for languages built on Parrot
   7
   8 =head1 SYNOPSIS
   9
  10 Tell the harness which language, and optionally compiler or other executable,
  11 you want to use in a file called F<t/harness>:
  12
  13   use Parrot::Test::Harness language => 'punie';
  14
  15   # or
  16
  17   use Parrot::Test::Harness language => 'perl6', compiler => 'perl6.pbc';
  18
  19   # or
  20
  21   use Parrot::Test::Harness
  22       language  => 'eclectus',
  23       exec      => [ 'petite', '--script' ],
  24       arguments => [ '--files' ],
  25       files     => [ 't/*.pl' ];
  26
  27 That's it. Seriously.
  28
  29 =head1 DESCRIPTION
  30
  31 This module provides a basic test harness for Parrot-hosted languages. Right
  32 now it parameterizes the three parameters that at least four language
  33 implementations need.
  34
  35 If you really want, you can pass a third option to the C<use> line.
  36 C<arguments> should be an array reference containing additional arguments (as
  37 you might find on the command line).
  38
  39 If you don't pass a C<compiler> or C<exec> argument pair, the harness will run the tests
  40 with C<perl>.  If you I<do> pass one of these pairs, the harness can use another executable.
  41 For C<exec> a reference to a an array of string is expected.
  42 For C<compiler> the harness will run the tests with
  43 C<parrot>, calling the C<compiler> file as the first argument.
  44
  45 This means that you can write your tests in your language itself and run them
  46 through your compiler itself.  If you can load PIR libraries from your
  47 language, you can even use the existing PIR testing tools.
  48
  49 =head1 AUTHOR
  50
  51 Written by chromatic with most of the intelligence stolen from the Punie
  52 harness and most of that probably stolen from Test::Harness
  53
  54 Please send patches and bug reports via Parrot's RT queue or to the mailing
  55 list.
  56
  57 =cut
  58
  59 package Parrot::Test::Harness;
  60
  61 use strict;
  62 use warnings;
  63
  64 use Carp;
  65 use File::Spec;
  66 use Test::Harness;
  67 use List::Util;
  68
  69 sub set_flags {
  70     my %options = @_;
  71
  72     $ENV{HARNESS_VERBOSE} = 1;
  73     if ( $options{exec} ) {
  74         $ENV{HARNESS_PERL} ||= join q{ }, @{$options{exec}};
  75     }
  76     elsif ( $options{compiler} ) {
  77         $ENV{HARNESS_PERL} ||= join q{}, "../../parrot ./$options{compiler}";
  78     }
  79
  80     return;
  81 }
  82
  83 # return a list of test files
  84 sub get_files {
  85     my %options = @_;
  86
  87 =pod
  88
  89 The option '--files' is used for supporting unified testing of language implementations.
  90 It is used by F<languages/t/harness> for collecting a list testfiles from
  91 many language implementations.
  92
  93 When that option is passed, a list of pathes to test files is printed.
  94 Currently these test files need to Perl 5 scripts.
  95 The file pathes are relative to a language implementation dir.
  96
  97 When there is no '--files' option, then things are saner.
  98 Nothing is printed. An array of file pathes is returned to the caller.
  99
 100 =cut
 101
 102     if ( grep { m/^--files$/ } @{ $options{arguments} } ) {
 103
 104         # --files indicates that 'languages/t/harness' wants a list of test files
 105         my @files;
 106         {
 107             # file patterns are either passed from a <language>/t/harness,
 108             # or the default is used
 109             my @file_patterns =
 110                 ( $options{files} && ref $options{files} eq 'ARRAY' ) ?
 111                     @{ $options{files} }
 112                     :
 113                     ( 't/*.t', 't/*/*.t' );
 114             if ( List::Util::first { $_ eq '--master' } @{ $options{arguments} } ) {
 115                 # if --master is passed, add the language dir as a prefix
 116                 @files = map { glob( File::Spec->catfile( $options{language}, $_  ) )
 117                              }
 118                              @file_patterns;
 119             }
 120             else {
 121                 @files = map { glob( $_ )
 122                              }
 123                              @file_patterns;
 124             }
 125         }
 126         print map { $_ . "\n" } @files;
 127
 128         exit;
 129     }
 130     elsif ( @{ $options{arguments} } ) {
 131
 132         # Someone specified tests for me to run.
 133         my @files;
 134         foreach my $arg ( @{ $options{arguments} } ) {
 135             -f $arg && push @files, glob $arg;
 136             -d $arg && push @files, glob( File::Spec->catfile( $arg, '*.t' ) );
 137         }
 138
 139         return @files;
 140     }
 141     else {
 142         # file patterns are either passed from a <language>/t/harness,
 143         # or the default is used
 144         my @file_patterns =
 145             ( $options{files} && ref $options{files} eq 'ARRAY' ) ?
 146                 @{ $options{files} }
 147                 :
 148                 ( 't/*.t', 't/*/*.t' );
 149         return map { glob( $_ )
 150                    }
 151                    @file_patterns;
 152     }
 153 }
 154
 155 sub import {
 156     my ( $class, %options ) = @_;
 157
 158     croak "Need a language\n" unless $options{language};
 159
 160     $options{arguments} ||= \@ARGV;
 161
 162     exit unless my @files = get_files(%options);
 163
 164     if (eval { require TAP::Harness; 1 }) {
 165         my %options =
 166               $options{exec}     ? ( exec => $options{exec} )
 167             : $options{compiler} ? ( exec => [ '../../parrot', './' . $options{compiler} ] )
 168             :                      ();
 169         TAP::Harness->new( \%options )->runtests( @files );
 170
 171         return;
 172     }
 173
 174     set_flags(%options);
 175
 176     local $Test::Harness::Switches = '';
 177
 178     no warnings 'redefine';
 179     local *Test::Harness::Straps::_INC2PERL5LIB = ## no critic Variables::ProhibitConditionalDeclarations
 180         sub { @INC }
 181         if $options{compiler};
 182
 183     runtests(@files);
 184 }
 185
 186 1;
 187
 188 # Local Variables:
 189 #   mode: cperl
 190 #   cperl-indent-level: 4
 191 #   fill-column: 100
 192 # End:
 193 # vim: expandtab shiftwidth=4: