File Coverage

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

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