File Coverage

File:lib/Parrot/Harness/Options.pm
Coverage:96.7%

linestmtbrancondsubcode
1# Copyright (C) 2006-2009, Parrot Foundation.
2
3 - 12
=head1 NAME

Parrot::Harness::Options - Handle options and argument processing in F<t/harness>

=head1 DESCRIPTION

This package exports subroutines on request only.  The subroutines are useful
in providing command-line options to Parrot's F<t/harness>.

=cut
13
14package Parrot::Harness::Options;
15
16
3
3
3
3
use strict;
17
3
3
3
3
use warnings;
18
19
3
3
3
3
use base qw( Exporter );
20our @EXPORT_OK = qw(
21    handle_long_options
22    get_test_prog_args
23    Usage
24);
25
26sub handle_long_options {
27
3
3
    my @argv = @_;
28
29
3
    my %cl_to_longopt = (
30        'gc-debug' => 'gc_debug',
31        'core-tests' => 'core_tests_only',
32        'runcore-tests' => 'runcore_tests_only',
33        'html' => 'html',
34        'code-tests' => 'code',
35        'run-exec' => 'run_exec',
36        'help' => 'help',
37        'archive' => 'archive',
38        'html' => 'html',
39    );
40
41
3
    my %longopts;
42
3
    foreach my $k (keys %cl_to_longopt) {
43
24
        my $cl_opt = '--' . $k;
44
24
54
        $longopts{$cl_to_longopt{$k}} = grep { $_ eq $cl_opt } @argv;
45
24
54
        @argv = grep { $_ ne $cl_opt } @argv;
46    }
47
48
3
100
    if ( $longopts{archive} ) {
49
2
3
        $longopts{send_to_smolder} = grep { $_ eq '--send-to-smolder' } @argv;
50
2
3
        @argv = grep { $_ ne '--send-to-smolder' } @argv;
51    }
52
53
3
    return (\%longopts, @argv);
54}
55
56sub get_test_prog_args {
57
4
4
    my ($optsref, $gc_debug, $run_exec) = @_;
58
59
4
    my %opts = remap_runcore_opts( $optsref );
60
4
13
    my $args = join(' ', map { "-$_" } keys %opts );
61
62
4
100
    $args =~ s/-O/-O$opts{O}/ if exists $opts{O};
63
4
    $args =~ s/-D/-D$opts{D}/;
64
4
100
    $args .= ' --gc-debug' if $gc_debug;
65    ## no critic qw(Bangs::ProhibitFlagComments)
66    # XXX find better way
67    # for passing run_exec to Parrot::Test
68
4
100
    $args .= ' --run-exec' if $run_exec;
69
70
4
    return $args;
71}
72
73# Given a hashref of options, convert to a hash; convert
74# some keys that used to map directly to parrot options. These keys
75# are not expected to have any values, so we cheat and push a parrot
76# commandline line option key/value into the key, and ignore the value.
77
78sub remap_runcore_opts
79{
80
4
4
    my ($opts_ref) = @_;
81
82
4
    my %remap = (
83        'j' => '-runcore=fast',
84        'G' => '-runcore=gcdebug',
85        'b' => '-runcore=bounds',
86        'f' => '-runcore=fast',
87        'r' => '-run-pbc',
88    );
89
90
4
    my %mapped;
91
4
    foreach my $opt (keys %$opts_ref) {
92
13
50
        if (exists $remap{$opt}) {
93
0
            $mapped{$remap{$opt}} = undef;
94        }
95        else {
96
13
            $mapped{$opt} = $opts_ref->{$opt};
97        }
98    }
99
4
    return %mapped;
100}
101
102sub Usage {
103
1
1
    print <<"EOF";
104perl t/harness [options] [testfiles]
105    -w ... warnings on
106    -b ... run bounds checked
107    --run-exec ... run exec core
108    -f ... run fast core
109    -j ... run fast core
110    -r ... run the compiled pbc
111    -v ... run parrot with -v : This is NOT the same as prove -v
112                   All tests run with this option will probably fail
113    -d ... run debug
114    -r ... assemble to PBC run PBC
115    -O[012] ... optimize
116    -D[number] ... pass debug flags to parrot interpreter
117    --gc-debug
118    --core-tests
119    --runcore-tests
120    --html
121    --code-tests
122    --archive ... create a TAP archive of the test run
123    --send-to-smolder ... send the TAP archive to the Parrot Smolder server
124EOF
125
126
1
    return;
127}
128
1291;
130
131# Local Variables:
132# mode: cperl
133# cperl-indent-level: 4
134# fill-column: 100
135# End:
136# vim: expandtab shiftwidth=4: