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