Commit | Line | Data |
---|---|---|
8a73d5dd RGS |
1 | #!./perl -w |
2 | ||
feafb1eb | 3 | # Tests for the command-line switches: |
fed0ca7f | 4 | # -0, -c, -l, -s, -m, -M, -V, -v, -h, -i, -E and all unknown |
48eaf804 | 5 | # Some switches have their own tests, see MANIFEST. |
8a73d5dd RGS |
6 | |
7 | BEGIN { | |
8 | chdir 't' if -d 't'; | |
9 | @INC = '../lib'; | |
7620c903 | 10 | require Config; import Config; |
8a73d5dd RGS |
11 | } |
12 | ||
768fd157 | 13 | BEGIN { require "./test.pl"; } |
8a73d5dd | 14 | |
1044e8d2 | 15 | plan(tests => 115); |
8a73d5dd | 16 | |
a09a0aa2 | 17 | use Config; |
ae7bdbc5 | 18 | BEGIN { eval 'use POSIX qw(setlocale LC_ALL)' } |
a09a0aa2 | 19 | |
b734d6c9 | 20 | # due to a bug in VMS's piping which makes it impossible for runperl() |
e54d2dfa JH |
21 | # to emulate echo -n (ie. stdin always winds up with a newline), these |
22 | # tests almost totally fail. | |
b734d6c9 MS |
23 | $TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS'; |
24 | ||
8a73d5dd RGS |
25 | my $r; |
26 | my @tmpfiles = (); | |
a29d0261 | 27 | END { unlink_all @tmpfiles } |
8a73d5dd RGS |
28 | |
29 | # Tests for -0 | |
30 | ||
31 | $r = runperl( | |
32 | switches => [ '-0', ], | |
33 | stdin => 'foo\0bar\0baz\0', | |
34 | prog => 'print qq(<$_>) while <>', | |
35 | ); | |
36 | is( $r, "<foo\0><bar\0><baz\0>", "-0" ); | |
37 | ||
38 | $r = runperl( | |
39 | switches => [ '-l', '-0', '-p' ], | |
40 | stdin => 'foo\0bar\0baz\0', | |
41 | prog => '1', | |
42 | ); | |
43 | is( $r, "foo\nbar\nbaz\n", "-0 after a -l" ); | |
44 | ||
45 | $r = runperl( | |
46 | switches => [ '-0', '-l', '-p' ], | |
47 | stdin => 'foo\0bar\0baz\0', | |
48 | prog => '1', | |
49 | ); | |
50 | is( $r, "foo\0bar\0baz\0", "-0 before a -l" ); | |
51 | ||
52 | $r = runperl( | |
53 | switches => [ sprintf("-0%o", ord 'x') ], | |
54 | stdin => 'fooxbarxbazx', | |
55 | prog => 'print qq(<$_>) while <>', | |
56 | ); | |
57 | is( $r, "<foox><barx><bazx>", "-0 with octal number" ); | |
58 | ||
59 | $r = runperl( | |
60 | switches => [ '-00', '-p' ], | |
61 | stdin => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n', | |
62 | prog => 's/\n/-/g;$_.=q(/)', | |
63 | ); | |
64 | is( $r, 'abc-def--/ghi-jkl-mno--/pq-/', '-00 (paragraph mode)' ); | |
65 | ||
66 | $r = runperl( | |
67 | switches => [ '-0777', '-p' ], | |
68 | stdin => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n', | |
69 | prog => 's/\n/-/g;$_.=q(/)', | |
70 | ); | |
71 | is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' ); | |
72 | ||
7f9e821f RGS |
73 | $r = runperl( |
74 | switches => [ '-066' ], | |
0fbedf1d | 75 | prog => 'BEGIN { print qq{($/)} } print qq{[$/]}', |
7f9e821f RGS |
76 | ); |
77 | is( $r, "(\066)[\066]", '$/ set at compile-time' ); | |
78 | ||
8a73d5dd RGS |
79 | # Tests for -c |
80 | ||
2d90ac95 | 81 | my $filename = tempfile(); |
8a73d5dd | 82 | SKIP: { |
b734d6c9 MS |
83 | local $TODO = ''; # this one works on VMS |
84 | ||
8a73d5dd RGS |
85 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); |
86 | print $f <<'SWTEST'; | |
87 | BEGIN { print "block 1\n"; } | |
88 | CHECK { print "block 2\n"; } | |
89 | INIT { print "block 3\n"; } | |
90 | print "block 4\n"; | |
91 | END { print "block 5\n"; } | |
92 | SWTEST | |
d1e4d418 | 93 | close $f or die "Could not close: $!"; |
8a73d5dd RGS |
94 | $r = runperl( |
95 | switches => [ '-c' ], | |
96 | progfile => $filename, | |
97 | stderr => 1, | |
98 | ); | |
99 | # Because of the stderr redirection, we can't tell reliably the order | |
100 | # in which the output is given | |
101 | ok( | |
102 | $r =~ /$filename syntax OK/ | |
103 | && $r =~ /\bblock 1\b/ | |
104 | && $r =~ /\bblock 2\b/ | |
105 | && $r !~ /\bblock 3\b/ | |
106 | && $r !~ /\bblock 4\b/ | |
107 | && $r !~ /\bblock 5\b/, | |
108 | '-c' | |
109 | ); | |
8a73d5dd RGS |
110 | } |
111 | ||
ae7bdbc5 FC |
112 | SKIP: { |
113 | skip "no POSIX on miniperl", 1, unless $INC{"POSIX.pm"}; | |
7620c903 | 114 | skip 'No locale testing without d_setlocale', 1 if(!$Config{d_setlocale}); |
ae7bdbc5 | 115 | |
1044e8d2 JK |
116 | my $tempdir = tempfile; |
117 | mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!"; | |
cdd06489 | 118 | |
5e4d35e6 RS |
119 | local $ENV{'LC_ALL'} = 'C'; # Keep the test simple: expect English |
120 | local $ENV{LANGUAGE} = 'C'; | |
2e3d3246 | 121 | setlocale(LC_ALL, "C"); |
5e4d35e6 | 122 | |
cdd06489 RS |
123 | # Win32 won't let us open the directory, so we never get to die with |
124 | # EISDIR, which happens after open. | |
dbab6833 FC |
125 | require Errno; |
126 | import Errno qw(EACCES EISDIR); | |
127 | my $error = do { | |
128 | local $! = $^O eq 'MSWin32' ? &EACCES : &EISDIR; "$!" | |
129 | }; | |
1044e8d2 JK |
130 | like( |
131 | runperl( switches => [ '-c' ], args => [ $tempdir ], stderr => 1), | |
5e4d35e6 | 132 | qr/Can't open perl script.*$tempdir.*\Q$error/s, |
1044e8d2 JK |
133 | "RT \#61362: Cannot syntax-check a directory" |
134 | ); | |
135 | rmdir $tempdir or die "Can't rmdir '$tempdir': $!"; | |
136 | } | |
137 | ||
8a73d5dd RGS |
138 | # Tests for -l |
139 | ||
140 | $r = runperl( | |
141 | switches => [ sprintf("-l%o", ord 'x') ], | |
142 | prog => 'print for qw/foo bar/' | |
143 | ); | |
144 | is( $r, 'fooxbarx', '-l with octal number' ); | |
145 | ||
146 | # Tests for -s | |
147 | ||
148 | $r = runperl( | |
149 | switches => [ '-s' ], | |
150 | prog => 'for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}', | |
151 | args => [ '--', '-abc=2', '-def', ], | |
152 | ); | |
153 | is( $r, '21-', '-s switch parsing' ); | |
154 | ||
2d90ac95 | 155 | $filename = tempfile(); |
8a73d5dd RGS |
156 | SKIP: { |
157 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); | |
158 | print $f <<'SWTEST'; | |
59e235cb GA |
159 | #!perl -s |
160 | BEGIN { print $x,$y; exit } | |
161 | SWTEST | |
162 | close $f or die "Could not close: $!"; | |
163 | $r = runperl( | |
164 | progfile => $filename, | |
165 | args => [ '-x=foo -y' ], | |
166 | ); | |
167 | is( $r, 'foo1', '-s on the shebang line' ); | |
59e235cb GA |
168 | } |
169 | ||
170 | # Bug ID 20011106.084 | |
2d90ac95 | 171 | $filename = tempfile(); |
59e235cb GA |
172 | SKIP: { |
173 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); | |
174 | print $f <<'SWTEST'; | |
f0b2cf55 YST |
175 | #!perl -sn |
176 | BEGIN { print $x; exit } | |
8a73d5dd | 177 | SWTEST |
d1e4d418 | 178 | close $f or die "Could not close: $!"; |
8a73d5dd | 179 | $r = runperl( |
8a73d5dd RGS |
180 | progfile => $filename, |
181 | args => [ '-x=foo' ], | |
182 | ); | |
59e235cb | 183 | is( $r, 'foo', '-sn on the shebang line' ); |
8a73d5dd RGS |
184 | } |
185 | ||
186 | # Tests for -m and -M | |
187 | ||
2d90ac95 NC |
188 | my $package = tempfile(); |
189 | $filename = "$package.pm"; | |
8a73d5dd RGS |
190 | SKIP: { |
191 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 ); | |
2d90ac95 NC |
192 | print $f <<"SWTESTPM"; |
193 | package $package; | |
194 | sub import { print map "<\$_>", \@_ } | |
8a73d5dd RGS |
195 | 1; |
196 | SWTESTPM | |
d1e4d418 | 197 | close $f or die "Could not close: $!"; |
8a73d5dd | 198 | $r = runperl( |
2d90ac95 | 199 | switches => [ "-M$package" ], |
8a73d5dd RGS |
200 | prog => '1', |
201 | ); | |
2d90ac95 | 202 | is( $r, "<$package>", '-M' ); |
8a73d5dd | 203 | $r = runperl( |
2d90ac95 | 204 | switches => [ "-M$package=foo" ], |
8a73d5dd RGS |
205 | prog => '1', |
206 | ); | |
2d90ac95 | 207 | is( $r, "<$package><foo>", '-M with import parameter' ); |
8a73d5dd | 208 | $r = runperl( |
2d90ac95 | 209 | switches => [ "-m$package" ], |
8a73d5dd RGS |
210 | prog => '1', |
211 | ); | |
b734d6c9 MS |
212 | |
213 | { | |
214 | local $TODO = ''; # this one works on VMS | |
215 | is( $r, '', '-m' ); | |
216 | } | |
8a73d5dd | 217 | $r = runperl( |
2d90ac95 | 218 | switches => [ "-m$package=foo,bar" ], |
8a73d5dd RGS |
219 | prog => '1', |
220 | ); | |
2d90ac95 | 221 | is( $r, "<$package><foo><bar>", '-m with import parameters' ); |
8a73d5dd | 222 | push @tmpfiles, $filename; |
0544e6df | 223 | |
3012b817 CB |
224 | { |
225 | local $TODO = ''; # these work on VMS | |
226 | ||
0544e6df RB |
227 | is( runperl( switches => [ '-MTie::Hash' ], stderr => 1, prog => 1 ), |
228 | '', "-MFoo::Bar allowed" ); | |
229 | ||
2d90ac95 | 230 | like( runperl( switches => [ "-M:$package" ], stderr => 1, |
3d7a9343 | 231 | prog => 'die q{oops}' ), |
0544e6df RB |
232 | qr/Invalid module name [\w:]+ with -M option\b/, |
233 | "-M:Foo not allowed" ); | |
234 | ||
235 | like( runperl( switches => [ '-mA:B:C' ], stderr => 1, | |
3d7a9343 | 236 | prog => 'die q{oops}' ), |
0544e6df RB |
237 | qr/Invalid module name [\w:]+ with -m option\b/, |
238 | "-mFoo:Bar not allowed" ); | |
239 | ||
240 | like( runperl( switches => [ '-m-A:B:C' ], stderr => 1, | |
3d7a9343 | 241 | prog => 'die q{oops}' ), |
0544e6df RB |
242 | qr/Invalid module name [\w:]+ with -m option\b/, |
243 | "-m-Foo:Bar not allowed" ); | |
244 | ||
245 | like( runperl( switches => [ '-m-' ], stderr => 1, | |
3d7a9343 | 246 | prog => 'die q{oops}' ), |
0544e6df RB |
247 | qr/Module name required with -m option\b/, |
248 | "-m- not allowed" ); | |
249 | ||
250 | like( runperl( switches => [ '-M-=' ], stderr => 1, | |
3d7a9343 | 251 | prog => 'die q{oops}' ), |
0544e6df RB |
252 | qr/Module name required with -M option\b/, |
253 | "-M- not allowed" ); | |
3012b817 | 254 | } # disable TODO on VMS |
8a73d5dd | 255 | } |
bda1f081 FC |
256 | is runperl(stderr => 1, prog => '#!perl -m'), |
257 | qq 'Too late for "-m" option at -e line 1.\n', '#!perl -m'; | |
258 | is runperl(stderr => 1, prog => '#!perl -M'), | |
259 | qq 'Too late for "-M" option at -e line 1.\n', '#!perl -M'; | |
e54d2dfa JH |
260 | |
261 | # Tests for -V | |
262 | ||
263 | { | |
264 | local $TODO = ''; # these ones should work on VMS | |
265 | ||
266 | # basic perl -V should generate significant output. | |
ceda46a1 | 267 | # we don't test actual format too much since it could change |
e54d2dfa JH |
268 | like( runperl( switches => ['-V'] ), qr/(\n.*){20}/, |
269 | '-V generates 20+ lines' ); | |
270 | ||
ceda46a1 JH |
271 | like( runperl( switches => ['-V'] ), |
272 | qr/\ASummary of my perl5 .*configuration:/, | |
273 | '-V looks okay' ); | |
274 | ||
e54d2dfa JH |
275 | # lookup a known config var |
276 | chomp( $r=runperl( switches => ['-V:osname'] ) ); | |
277 | is( $r, "osname='$^O';", 'perl -V:osname'); | |
278 | ||
279 | # lookup a nonexistent var | |
280 | chomp( $r=runperl( switches => ['-V:this_var_makes_switches_test_fail'] ) ); | |
281 | is( $r, "this_var_makes_switches_test_fail='UNKNOWN';", | |
282 | 'perl -V:unknown var'); | |
283 | ||
284 | # regexp lookup | |
285 | # platforms that don't like this quoting can either skip this test | |
286 | # or fix test.pl _quote_args | |
287 | $r = runperl( switches => ['"-V:i\D+size"'] ); | |
288 | # should be unlike( $r, qr/^$|not found|UNKNOWN/ ); | |
289 | like( $r, qr/^(?!.*(not found|UNKNOWN))./, 'perl -V:re got a result' ); | |
290 | ||
291 | # make sure each line we got matches the re | |
292 | ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' ); | |
293 | } | |
ceda46a1 JH |
294 | |
295 | # Tests for -v | |
296 | ||
297 | { | |
298 | local $TODO = ''; # these ones should work on VMS | |
46807d8e YO |
299 | # there are definitely known build configs where this test will fail |
300 | # DG/UX comes to mind. Maybe we should remove these special cases? | |
a64c093f TC |
301 | SKIP: |
302 | { | |
303 | skip "Win32 miniperl produces a default archname in -v", 1 | |
304 | if $^O eq 'MSWin32' && is_miniperl; | |
305 | my $v = sprintf "%vd", $^V; | |
306 | my $ver = $Config{PERL_VERSION}; | |
307 | my $rel = $Config{PERL_SUBVERSION}; | |
308 | like( runperl( switches => ['-v'] ), | |
309 | qr/This is perl 5, version \Q$ver\E, subversion \Q$rel\E \(v\Q$v\E(?:[-*\w]+| \([^)]+\))?\) built for \Q$Config{archname}\E.+Copyright.+Larry Wall.+Artistic License.+GNU General Public License/s, | |
310 | '-v looks okay' ); | |
311 | } | |
ceda46a1 | 312 | } |
b8e3af44 JH |
313 | |
314 | # Tests for -h | |
315 | ||
316 | { | |
317 | local $TODO = ''; # these ones should work on VMS | |
318 | ||
319 | like( runperl( switches => ['-h'] ), | |
a09a0aa2 | 320 | qr/Usage: .+(?i:perl(?:$Config{_exe})?).+switches.+programfile.+arguments/, |
b8e3af44 JH |
321 | '-h looks okay' ); |
322 | ||
323 | } | |
324 | ||
fed0ca7f | 325 | # Tests for switches which do not exist |
b8e3af44 | 326 | |
96889982 | 327 | foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_") |
b8e3af44 JH |
328 | { |
329 | local $TODO = ''; # these ones should work on VMS | |
330 | ||
fed0ca7f | 331 | like( runperl( switches => ["-$switch"], stderr => 1, |
3d7a9343 | 332 | prog => 'die q{oops}' ), |
fed0ca7f NC |
333 | qr/\QUnrecognized switch: -$switch (-h will show valid options)./, |
334 | "-$switch correctly unknown" ); | |
b8e3af44 | 335 | |
b7e077d0 FC |
336 | # [perl #104288] |
337 | like( runperl( stderr => 1, prog => "#!perl -$switch" ), | |
338 | qr/^Unrecognized switch: -$switch \(-h will show valid (?x: | |
339 | )options\) at -e line 1\./, | |
340 | "-$switch unrecognised on #! line" ); | |
341 | } | |
342 | ||
343 | # Tests for unshebangable switches | |
344 | for (qw( e f x E S V )) { | |
345 | $r = runperl( | |
346 | stderr => 1, | |
347 | prog => "#!perl -$_", | |
348 | ); | |
349 | is $r, "Can't emulate -$_ on #! line at -e line 1.\n","-$_ on #! line"; | |
b8e3af44 | 350 | } |
feafb1eb JH |
351 | |
352 | # Tests for -i | |
353 | ||
354 | { | |
355 | local $TODO = ''; # these ones should work on VMS | |
356 | ||
a29d0261 | 357 | sub do_i_unlink { unlink_all("file", "file.bak") } |
feafb1eb JH |
358 | |
359 | open(FILE, ">file") or die "$0: Failed to create 'file': $!"; | |
360 | print FILE <<__EOF__; | |
361 | foo yada dada | |
362 | bada foo bing | |
363 | king kong foo | |
364 | __EOF__ | |
365 | close FILE; | |
366 | ||
367 | END { do_i_unlink() } | |
368 | ||
369 | runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['file'] ); | |
370 | ||
371 | open(FILE, "file") or die "$0: Failed to open 'file': $!"; | |
372 | chomp(my @file = <FILE>); | |
373 | close FILE; | |
374 | ||
375 | open(BAK, "file.bak") or die "$0: Failed to open 'file': $!"; | |
376 | chomp(my @bak = <BAK>); | |
377 | close BAK; | |
378 | ||
379 | is(join(":", @file), | |
380 | "bar yada dada:bada bar bing:king kong bar", | |
381 | "-i new file"); | |
382 | is(join(":", @bak), | |
383 | "foo yada dada:bada foo bing:king kong foo", | |
384 | "-i backup file"); | |
82f96200 JL |
385 | |
386 | my $out1 = runperl( | |
387 | switches => ['-i.bak -p'], | |
388 | prog => 'exit', | |
389 | stderr => 1, | |
390 | stdin => "1\n", | |
391 | ); | |
392 | is( | |
393 | $out1, | |
394 | "-i used with no filenames on the command line, reading from STDIN.\n", | |
395 | "warning when no files given" | |
396 | ); | |
397 | my $out2 = runperl( | |
398 | switches => ['-i.bak -p'], | |
399 | prog => 'exit', | |
400 | stderr => 1, | |
401 | stdin => "1\n", | |
402 | args => ['file'], | |
403 | ); | |
404 | is($out2, "", "no warning when files given"); | |
feafb1eb | 405 | } |
bc9b29db RH |
406 | |
407 | # Tests for -E | |
408 | ||
3012b817 CB |
409 | $TODO = ''; # the -E tests work on VMS |
410 | ||
bc9b29db RH |
411 | $r = runperl( |
412 | switches => [ '-E', '"say q(Hello, world!)"'] | |
413 | ); | |
414 | is( $r, "Hello, world!\n", "-E say" ); | |
415 | ||
416 | ||
417 | $r = runperl( | |
0f539b13 | 418 | switches => [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"'] |
bc9b29db RH |
419 | ); |
420 | is( $r, "Hello, world!\n", "-E ~~" ); | |
421 | ||
422 | $r = runperl( | |
0f539b13 | 423 | switches => [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}'] |
bc9b29db RH |
424 | ); |
425 | is( $r, "Hello, world!\n", "-E given" ); | |
9f639728 FR |
426 | |
427 | $r = runperl( | |
f21873d1 | 428 | switches => [ '-nE', q("} END { say q/affe/") ], |
9f639728 FR |
429 | stdin => 'zomtek', |
430 | ); | |
431 | is( $r, "affe\n", '-E works outside of the block created by -n' ); | |
d3133c89 | 432 | |
53eb19dd S |
433 | $r = runperl( |
434 | switches => [ '-E', q("*{'bar'} = sub{}; print 'Hello, world!',qq|\n|;")] | |
435 | ); | |
436 | is( $r, "Hello, world!\n", "-E does not enable strictures" ); | |
437 | ||
d3133c89 NC |
438 | # RT #30660 |
439 | ||
440 | $filename = tempfile(); | |
441 | SKIP: { | |
442 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); | |
443 | print $f <<'SWTEST'; | |
444 | #!perl -w -iok | |
445 | print "$^I\n"; | |
446 | SWTEST | |
447 | close $f or die "Could not close: $!"; | |
448 | $r = runperl( | |
449 | progfile => $filename, | |
450 | ); | |
451 | like( $r, qr/ok/, 'Spaces on the #! line (#30660)' ); | |
452 | } |