-
Notifications
You must be signed in to change notification settings - Fork 138
/
options.t
158 lines (116 loc) · 4.36 KB
/
options.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
#!perl
# Copyright (C) 2005-2010, Parrot Foundation.
=head1 NAME
t/run/options.t - test parrot command line options
=head1 SYNOPSIS
% prove t/run/options.t
=head1 DESCRIPTION
Tests C<parrot> command line options.
=cut
use strict;
use warnings;
use lib qw( lib . ../lib ../../lib );
use Test::More tests => 35;
use Parrot::Config;
use File::Temp 0.13 qw/tempfile/;
use File::Spec;
my $PARROT = ".$PConfig{slash}$PConfig{test_prog}";
# looking at the help message
my $help_message = `$PARROT --help`;
is( substr( $help_message, 0, 23 ), 'parrot [Options] <file>', 'Start of help message' );
ok( index( $help_message, '-t --trace [flags]' ) > 0, 'help for --trace' );
# setup PIR files for tests below
my $first_pir_file = create_pir_file('first');
my $second_pir_file = create_pir_file('second');
# executing a PIR file
is( `"$PARROT" "$first_pir_file"`, "first\n", 'running first.pir' );
is( `"$PARROT" "$second_pir_file"`, "second\n", 'running second.pir' );
# Ignore further arguments
is( `"$PARROT" "$first_pir_file" "$second_pir_file"`, "first\n", 'ignore a pir-file' );
is( `"$PARROT" "$first_pir_file" "asdf"`, "first\n", 'ignore nonsense' );
# redirect STDERR to avoid warnings
my $redir = '2>' . File::Spec->devnull();
# --pre-process-only
# This is just sanity testing
my $expected_preprocesses_pir = <<'END_PIR';
.macro
.sub main :main
say "first"
.end
END_PIR
is( `"$PARROT" -E "$first_pir_file" $redir`, $expected_preprocesses_pir, 'option -E' );
is( `"$PARROT" --pre-process-only "$first_pir_file" $redir`,
$expected_preprocesses_pir, 'option --pre-process-only' );
# Test the trace option
is( `"$PARROT" -t "$first_pir_file" $redir`, "first\n", 'option -t' );
is( `"$PARROT" --trace "$first_pir_file" $redir`, "first\n", 'option --trace' );
is( `"$PARROT" -t "$first_pir_file" "$second_pir_file" $redir`, "second\n",
'option -t with flags' );
is( `"$PARROT" --trace "$first_pir_file" "$second_pir_file" $redir`,
"second\n", 'option --trace with flags' );
## test the -R & --runcore options
{
my $cmd;
## this test assumes these cores work on all platforms (a safe assumption)
for my $val (qw/ slow fast bounds trace /) {
for my $opt ( '-R ', '--runcore ', '--runcore=' ) {
$cmd = qq{"$PARROT" $opt$val "$second_pir_file" $redir};
is( qx{$cmd}, "second\n", "<$opt$val> option)" ) or diag $cmd;
}
}
$cmd = qq{"$PARROT" -D 8 -R slow "$second_pir_file" $redir};
is( qx{$cmd}, "second\n", "-r option <$cmd>" );
$cmd = qq{"$PARROT" -D 8 -R slow "$second_pir_file" 2>&1};
like( qx{$cmd}, qr/Parrot VM: slow core/, "-r option <$cmd>" );
}
## TT #1150 test remaining options
# Test --runtime-prefix
like( qx{$PARROT --runtime-prefix}, qr/^.+$/, "--runtime-prefix" );
# TT #1797: check for warning error and mask off "did it crash?" bits
my $output = qx{$PARROT --gc-dynamic-threshold 2>&1 };
my $exit = $? & 127;
like( $output, qr/--gc-dynamic-threshold needs an argument/,
'--gc-dynamic-threshold needs argument warning' );
is( $exit, 0, '... and should not crash' );
# GC nursery-size check for warning error and mask off "did it crash?" bits
$output = qx{$PARROT --gc-nursery-size 2>&1 };
$exit = $? & 127;
like( $output, qr/--gc-nursery-size needs an argument/,
'--gc-nursery-size needs argument warning' );
is( $exit, 0, '... and should not crash' );
$output = qx{$PARROT --gc-nursery-size=51 2>&1 };
$exit = $? & 127;
like( $output, qr/maximum GC nursery size is 50%/,
'--gc-nursery-size max warning' );
is( $exit, 0, '... and should not crash' );
# Test --leak-test
is( qx{$PARROT --leak-test "$first_pir_file"}, "first\n", '--leak-test' );
# clean up temporary files
unlink $first_pir_file;
unlink $second_pir_file;
sub create_pir_file {
my $word = shift;
my ( $fh, $filename ) = tempfile( UNLINK => 0, SUFFIX => '.pir', UNLINK => 1 );
print $fh <<"END_PIR";
.macro println(word)
say .word
.endm
.sub main :main
.println( "$word" )
.end
END_PIR
close $fh;
return $filename;
}
#make sure that VERSION matches the output of --version
open(my $version_fh, "<", "VERSION") or die "couldn't open VERSION: $!";
my $file_version = <$version_fh>;
chomp($file_version);
close($version_fh);
like( qx{$PARROT --version}, qr/.*${file_version}.*/, "VERSION matches --version" );
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: