Skip to content
This repository
  • 11 commits
  • 2 files changed
  • 0 comments
  • 1 contributor
Jan 28, 2012
Brian Gernhardt Enumerate options to test
This fixes nothing, but tells us how far we need to go.
7ef799e
Brian Gernhardt t/run/options: test -V and -h
Run the tests for --version and --help again.
f83019f
Brian Gernhardt t/run/options: test --parrot-debug
There were already tests for -D, so hijack that.
This also provides more useful descriptions of the tests
f7f62d6
Brian Gernhardt t/run/options: De-duplicate long and short tests
There were a couple tests that looked like

is( 'parrot -l', 'expect', 'option -l' )
is( 'parrot --long', 'expect', 'option --long' )

Make the fact that those tests are the same explicit by wrapping them
in a loop.  This also makes them consistent with the tests to come.
fe5b1d6
Brian Gernhardt t/run/options: Factor out check for needs argument 32624b2
Brian Gernhardt t/run/options: Perform all tests before cleanup 59b7cec
Brian Gernhardt t/run/options: test --hash-seed 3d19b3b
Brian Gernhardt t/run/options: test --help-debug e98bd83
Brian Gernhardt docs/running.pod: -w doesn't take an argument 060691d
Brian Gernhardt t/run/options.t: test -w/--warnings 2e9048c
Brian Gernhardt t/run/options.t: test --destroy-at-end efa33be
2  docs/running.pod
Source Rendered
@@ -161,7 +161,7 @@ Run with the slow core and print trace information to B<stderr>. See C<parrot
161 161
 
162 162
 =item -w, --warnings
163 163
 
164  
-Turn on warnings. See C<parrot --help-debug> for available flag bits.
  164
+Turn on warnings.
165 165
 
166 166
 =item -D, --parrot-debug
167 167
 
169  t/run/options.t
@@ -19,7 +19,7 @@ use strict;
19 19
 use warnings;
20 20
 use lib qw( lib . ../lib ../../lib );
21 21
 
22  
-use Test::More tests => 35;
  22
+use Test::More tests => 57;
23 23
 use Parrot::Config;
24 24
 use File::Temp 0.13 qw/tempfile/;
25 25
 use File::Spec;
@@ -27,9 +27,19 @@ use File::Spec;
27 27
 my $PARROT = ".$PConfig{slash}$PConfig{test_prog}";
28 28
 
29 29
 # looking at the help message
30  
-my $help_message = `$PARROT --help`;
31  
-is( substr( $help_message, 0, 23 ), 'parrot [Options] <file>', 'Start of help message' );
32  
-ok( index( $help_message, '-t --trace [flags]' ) > 0, 'help for --trace' );
  30
+for my $help ('-h', '--help') {
  31
+    my $help_message = `$PARROT $help`;
  32
+    is( substr( $help_message, 0, 23 ), 'parrot [Options] <file>', "Start of $help message" );
  33
+    ok( index( $help_message, '-t --trace [flags]' ) > 0, '$help for --trace' );
  34
+}
  35
+
  36
+# looking at the debug help message
  37
+{
  38
+    my $help_message = `"$PARROT" --help-debug`;
  39
+    ok( index( $help_message, '--imcc-debug' ) >= 0, '--help-debug for --imcc-debug' );
  40
+    ok( index( $help_message, '--parrot-debug' ) >= 0, '--help-debug for --parrot-debug' );
  41
+    ok( index( $help_message, '--trace' ) >= 0, '--help-debug for --trace' );
  42
+}
33 43
 
34 44
 # setup PIR files for tests below
35 45
 my $first_pir_file  = create_pir_file('first');
@@ -59,17 +69,15 @@ say "first"
59 69
 .end
60 70
 
61 71
 END_PIR
62  
-is( `"$PARROT" -E "$first_pir_file" $redir`, $expected_preprocesses_pir, 'option -E' );
63  
-is( `"$PARROT" --pre-process-only "$first_pir_file" $redir`,
64  
-$expected_preprocesses_pir, 'option --pre-process-only' );
  72
+for my $e ('-E', '--pre-process-only') {
  73
+    is( `"$PARROT" $e "$first_pir_file" $redir`, $expected_preprocesses_pir, "option $e" );
  74
+}
65 75
 
66 76
 # Test the trace option
67  
-is( `"$PARROT" -t "$first_pir_file" $redir`, "first\n", 'option -t' );
68  
-is( `"$PARROT" --trace "$first_pir_file" $redir`, "first\n", 'option --trace' );
69  
-is( `"$PARROT" -t "$first_pir_file" "$second_pir_file" $redir`, "second\n",
70  
-'option -t with flags' );
71  
-is( `"$PARROT" --trace "$first_pir_file" "$second_pir_file" $redir`,
72  
-"second\n", 'option --trace with flags' );
  77
+for my $t ('-t', '--trace') {
  78
+    is( `"$PARROT" $t "$first_pir_file" $redir`, "first\n", "option $t" );
  79
+    is( `"$PARROT" $t "$first_pir_file" "$second_pir_file" $redir`, "second\n", "option $t with flags" );
  80
+}
73 81
 
74 82
 ## test the -R & --runcore options
75 83
 {
@@ -83,41 +91,85 @@ for my $val (qw/ slow fast bounds trace /) {
83 91
     }
84 92
 }
85 93
 
86  
-$cmd = qq{"$PARROT" -D 8 -R slow "$second_pir_file" $redir};
87  
-is( qx{$cmd}, "second\n", "-r option <$cmd>" );
  94
+for my $d8 ('-D 8', '--parrot-debug 8', '--parrot-debug=8') {
  95
+    $cmd = qq{"$PARROT" $d8 -R slow "$second_pir_file" $redir};
  96
+    is( qx{$cmd}, "second\n", "$d8 doesn't touch STDOUT" );
88 97
 
89  
-$cmd = qq{"$PARROT" -D 8 -R slow "$second_pir_file" 2>&1};
90  
-like( qx{$cmd}, qr/Parrot VM: slow core/, "-r option <$cmd>" );
  98
+    $cmd = qq{"$PARROT" $d8 -R slow "$second_pir_file" 2>&1};
  99
+    like( qx{$cmd}, qr/Parrot VM: slow core/, "$d8 prints runcore name" );
  100
+}
91 101
 }
92  
-
93  
-## GH #346 test remaining options
94 102
 
95 103
 # Test --runtime-prefix
96 104
 like( qx{$PARROT --runtime-prefix}, qr/^.+$/, "--runtime-prefix" );
97 105
 
98 106
 # TT #1797: check for warning error and mask off "did it crash?" bits
99  
-my $output = qx{$PARROT --gc-dynamic-threshold 2>&1 };
100  
-my $exit   = $? & 127;
101  
-like( $output, qr/--gc-dynamic-threshold needs an argument/,
102  
-             '--gc-dynamic-threshold needs argument warning' );
103  
-is( $exit, 0, '... and should not crash' );
  107
+needs_an_argument('--gc-dynamic-threshold');
104 108
 
105 109
 # GC nursery-size check for warning error and mask off "did it crash?" bits
106  
-$output = qx{$PARROT --gc-nursery-size 2>&1 };
107  
-$exit   = $? & 127;
108  
-like( $output, qr/--gc-nursery-size needs an argument/,
109  
-                 '--gc-nursery-size needs argument warning' );
110  
-is( $exit, 0, '... and should not crash' );
  110
+needs_an_argument('--gc-nursery-size');
  111
+
  112
+{
  113
+    my $output = qx{$PARROT --gc-nursery-size=51 2>&1 };
  114
+    my $exit   = $? & 127;
  115
+    like( $output, qr/maximum GC nursery size is 50%/,
  116
+                     '--gc-nursery-size max warning' );
  117
+    is( $exit, 0, '... and should not crash' );
  118
+}
111 119
 
112  
-$output = qx{$PARROT --gc-nursery-size=51 2>&1 };
113  
-$exit   = $? & 127;
114  
-like( $output, qr/maximum GC nursery size is 50%/,
115  
-                 '--gc-nursery-size max warning' );
116  
-is( $exit, 0, '... and should not crash' );
  120
+# Test --leak-test/--destroy-at-end
  121
+for my $leak ( '--leak-test', '--destroy-at-end' ) {
  122
+    is( qx{$PARROT $leak "$first_pir_file"}, "first\n", '--leak-test' );
  123
+}
  124
+
  125
+#make sure that VERSION matches the output of --version
  126
+open(my $version_fh, "<", "VERSION") or die "couldn't open VERSION: $!";
  127
+my $file_version = <$version_fh>;
  128
+chomp($file_version);
  129
+close($version_fh);
  130
+for my $version ('-V', '--version') {
  131
+    like( qx{$PARROT $version}, qr/.*${file_version}.*/, "VERSION matches $version" );
  132
+}
  133
+
  134
+# Test --hash-seed
  135
+needs_an_argument('--hash-seed');
  136
+
  137
+for my $hash ('--hash-seed ', '--hash-seed=') {
  138
+    my $arg = 'xyz';
  139
+    my $output = qx{"$PARROT" $hash$arg 2>&1};
  140
+    my $exit = $? & 127;
  141
+    like( $output, qr/invalid hash seed/, "$hash rejects bad hash" );
  142
+    is( $exit, 0, '... and should not crash' );
  143
+
  144
+    $arg = 'f00';
  145
+    is( qx{"$PARROT" $hash$arg "$first_pir_file" $redir}, "first\n",
  146
+        "$hash takes a hex value" );
  147
+}
  148
+
  149
+# Test -w/--warnings
  150
+{
  151
+    # Create a simple file that throws an Undef warning.
  152
+    my ($fh, $filename) = tempfile( UNLINK => 0, SUFFIX => '.pir', UNLINK => 1 );
  153
+    print $fh <<'END_PIR';
  154
+.sub 'main' :main
  155
+   $P0 = new 'Undef'
  156
+   $S0 = $P0
  157
+.end
  158
+END_PIR
  159
+    close $fh;
  160
+
  161
+    unlike( qx{"$PARROT" "$filename" 2>&1}, qr/Undef/,
  162
+        'no complaint without warning flag' );
  163
+
  164
+    for my $w ('-w', '--warnings') {
  165
+        like( qx{"$PARROT" $w "$filename" 2>&1}, qr/Undef/,
  166
+            "$w warns about Undef" );
  167
+    }
  168
+    
  169
+    unlink $filename;
  170
+}
117 171
 
118 172
 
119  
-# Test --leak-test
120  
-is( qx{$PARROT --leak-test "$first_pir_file"}, "first\n", '--leak-test' );
121 173
 
122 174
 # clean up temporary files
123 175
 unlink $first_pir_file;
@@ -142,17 +194,50 @@ END_PIR
142 194
     return $filename;
143 195
 }
144 196
 
145  
-#make sure that VERSION matches the output of --version
146  
-open(my $version_fh, "<", "VERSION") or die "couldn't open VERSION: $!";
147  
-my $file_version = <$version_fh>;
148  
-chomp($file_version);
149  
-close($version_fh);
150  
-like( qx{$PARROT --version}, qr/.*${file_version}.*/, "VERSION matches --version" );
  197
+# Check that an option checks for its argument
  198
+sub needs_an_argument {
  199
+    my $arg    = shift;
  200
+    my $output = qx{$PARROT $arg 2>&1 };
  201
+    my $exit   = $? & 127;
  202
+    like( $output, qr/$arg needs an argument/, "$arg needs argument warning" );
  203
+    is( $exit, 0, '... and should not crash' );
  204
+}
  205
+
151 206
 
  207
+## GH #346 test remaining options
  208
+
  209
+# TODO: Add tests for more options
  210
+# Make sure you include attached versions
  211
+# -I --include PATH
  212
+# -L --library PATH
  213
+# -X --dynext PATH
  214
+# -G --no-gc
  215
+# -h --gc ms2|gms|ms|inf
  216
+#    --gc-min-threshold
  217
+#    --gc-debug
  218
+# -. --wait
  219
+# FILE  (.pasm, .pir, .pbc)
  220
+
  221
+# These are IMCC options.  Add tests here or in t/compilers/imcc ?
  222
+# -d --imcc-debug HEX
  223
+# -v --verbose
  224
+# -o --output FILE
  225
+#        .pasm, .pbc, .o endings
  226
+#    --output-pbc
  227
+# -O --optimize INT
  228
+# -a --pasm
  229
+# -c --pbc
  230
+# -r --run-pbc
  231
+# -y --yydebug
  232
+# -p --profile (in docs/running.pod, not in --help)
  233
+
  234
+# These IMCC options are tested here.  Move them?
  235
+# -E --pre-process-only
152 236
 
153 237
 # Local Variables:
154 238
 #   mode: cperl
155 239
 #   cperl-indent-level: 4
  240
+
156 241
 #   fill-column: 100
157 242
 # End:
158 243
 # vim: expandtab shiftwidth=4:

No commit comments for this range

Something went wrong with that request. Please try again.