1#!./perl -w 2 3# Tests for the command-line switches: 4# -0, -c, -l, -s, -m, -M, -V, -v, -h, -i, -E and all unknown 5# Some switches have their own tests, see MANIFEST. 6 7BEGIN { 8 chdir 't' if -d 't'; 9 @INC = '../lib'; 10 require Config; import Config; 11} 12 13BEGIN { require "./test.pl"; require "./loc_tools.pl"; } 14 15plan(tests => 137); 16 17use Config; 18 19# due to a bug in VMS's piping which makes it impossible for runperl() 20# to emulate echo -n (ie. stdin always winds up with a newline), these 21# tests almost totally fail. 22$TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS'; 23 24my $r; 25my @tmpfiles = (); 26END { unlink_all @tmpfiles } 27 28# Tests for -0 29 30$r = runperl( 31 switches => [ '-0', ], 32 stdin => 'foo\0bar\0baz\0', 33 prog => 'print qq(<$_>) while <>', 34); 35is( $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); 42is( $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); 49is( $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); 56is( $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); 63is( $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); 70is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' ); 71 72$r = runperl( 73 switches => [ '-066' ], 74 prog => 'BEGIN { print qq{($/)} } print qq{[$/]}', 75); 76is( $r, "(\066)[\066]", '$/ set at compile-time' ); 77 78# Tests for -c 79 80my $filename = tempfile(); 81SKIP: { 82 local $TODO = ''; # this one works on VMS 83 84 open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); 85 print $f <<'SWTEST'; 86BEGIN { print "block 1\n"; } 87CHECK { print "block 2\n"; } 88INIT { print "block 3\n"; } 89 print "block 4\n"; 90END { print "block 5\n"; } 91SWTEST 92 close $f or die "Could not close: $!"; 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 ); 109} 110 111SKIP: { 112 skip 'locales not available', 1 unless locales_enabled('LC_ALL'); 113 114 my $tempdir = tempfile; 115 mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!"; 116 117 local $ENV{'LC_ALL'} = 'C'; # Keep the test simple: expect English 118 local $ENV{LANGUAGE} = 'C'; 119 setlocale(LC_ALL, "C"); 120 121 # Win32 won't let us open the directory, so we never get to die with 122 # EISDIR, which happens after open. 123 require Errno; 124 import Errno qw(EACCES EISDIR); 125 my $error = do { 126 local $! = $^O eq 'MSWin32' ? &EACCES : &EISDIR; "$!" 127 }; 128 like( 129 runperl( switches => [ '-c' ], args => [ $tempdir ], stderr => 1), 130 qr/Can't open perl script.*$tempdir.*\Q$error/s, 131 "RT \#61362: Cannot syntax-check a directory" 132 ); 133 rmdir $tempdir or die "Can't rmdir '$tempdir': $!"; 134} 135 136# Tests for -l 137 138$r = runperl( 139 switches => [ sprintf("-l%o", ord 'x') ], 140 prog => 'print for qw/foo bar/' 141); 142is( $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); 151is( $r, '21-', '-s switch parsing' ); 152 153$filename = tempfile(); 154SKIP: { 155 open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); 156 print $f <<'SWTEST'; 157#!perl -s 158BEGIN { print $x,$y; exit } 159SWTEST 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' ); 166} 167 168# Bug ID 20011106.084 (#7876) 169$filename = tempfile(); 170SKIP: { 171 open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); 172 print $f <<'SWTEST'; 173#!perl -sn 174BEGIN { print $x; exit } 175SWTEST 176 close $f or die "Could not close: $!"; 177 $r = runperl( 178 progfile => $filename, 179 args => [ '-x=foo' ], 180 ); 181 is( $r, 'foo', '-sn on the shebang line' ); 182} 183 184# Tests for -m and -M 185 186my $package = tempfile(); 187$filename = "$package.pm"; 188SKIP: { 189 open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 ); 190 print $f <<"SWTESTPM"; 191package $package; 192sub import { print map "<\$_>", \@_ } 1931; 194SWTESTPM 195 close $f or die "Could not close: $!"; 196 $r = runperl( 197 switches => [ "-I.", "-M$package" ], 198 prog => '1', 199 ); 200 is( $r, "<$package>", '-M' ); 201 $r = runperl( 202 switches => [ "-I.", "-M$package=foo" ], 203 prog => '1', 204 ); 205 is( $r, "<$package><foo>", '-M with import parameter' ); 206 $r = runperl( 207 switches => [ "-m$package" ], 208 prog => '1', 209 ); 210 211 { 212 local $TODO = ''; # this one works on VMS 213 is( $r, '', '-m' ); 214 } 215 $r = runperl( 216 switches => [ "-I.", "-m$package=foo,bar" ], 217 prog => '1', 218 ); 219 is( $r, "<$package><foo><bar>", '-m with import parameters' ); 220 push @tmpfiles, $filename; 221 222 { 223 local $TODO = ''; # these work on VMS 224 225 is( runperl( switches => [ '-MTie::Hash' ], stderr => 1, prog => 1 ), 226 '', "-MFoo::Bar allowed" ); 227 228 like( runperl( switches => [ "-M:$package" ], stderr => 1, 229 prog => 'die q{oops}' ), 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, 234 prog => 'die q{oops}' ), 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, 239 prog => 'die q{oops}' ), 240 qr/Invalid module name [\w:]+ with -m option\b/, 241 "-m-Foo:Bar not allowed" ); 242 243 like( runperl( switches => [ '-m-' ], stderr => 1, 244 prog => 'die q{oops}' ), 245 qr/Module name required with -m option\b/, 246 "-m- not allowed" ); 247 248 like( runperl( switches => [ '-M-=' ], stderr => 1, 249 prog => 'die q{oops}' ), 250 qr/Module name required with -M option\b/, 251 "-M- not allowed" ); 252 } # disable TODO on VMS 253} 254is runperl(stderr => 1, prog => '#!perl -m'), 255 qq 'Too late for "-m" option at -e line 1.\n', '#!perl -m'; 256is runperl(stderr => 1, prog => '#!perl -M'), 257 qq 'Too late for "-M" option at -e line 1.\n', '#!perl -M'; 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. 265 # we don't test actual format too much since it could change 266 like( runperl( switches => ['-V'] ), qr/(\n.*){20}/, 267 '-V generates 20+ lines' ); 268 269 like( runperl( switches => ['-V'] ), 270 qr/\ASummary of my perl5 .*configuration:/, 271 '-V looks okay' ); 272 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} 292 293# Tests for -v 294 295{ 296 local $TODO = ''; # these ones should work on VMS 297 # There may be build configs where this test will fail; DG/UX was one, 298 # but we no longer support it. Maybe we should remove these special cases? 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 } 310} 311 312# Tests for -h 313 314{ 315 local $TODO = ''; # these ones should work on VMS 316 317 like( runperl( switches => ['-h'] ), 318 qr/Usage: .+(?i:perl(?:$Config{_exe})?).+switches.+programfile.+arguments/, 319 '-h looks okay' ); 320 321} 322 323# Tests for switches which do not exist 324 325foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_") 326{ 327 local $TODO = ''; # these ones should work on VMS 328 329 like( runperl( switches => ["-$switch"], stderr => 1, 330 prog => 'die q{oops}' ), 331 qr/\QUnrecognized switch: -$switch (-h will show valid options)./, 332 "-$switch correctly unknown" ); 333 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 342for (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"; 348} 349 350# Tests for -i 351 352SKIP: 353{ 354 local $TODO = ''; # these ones should work on VMS 355 356 sub do_i_unlink { unlink_all("tmpswitches", "tmpswitches.bak") } 357 358 open(FILE, ">tmpswitches") or die "$0: Failed to create 'tmpswitches': $!"; 359 my $yada = <<__EOF__; 360foo yada dada 361bada foo bing 362king kong foo 363__EOF__ 364 print FILE $yada; 365 close FILE; 366 367 END { do_i_unlink() } 368 369 runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['tmpswitches'] ); 370 371 open(FILE, "tmpswitches") or die "$0: Failed to open 'tmpswitches': $!"; 372 chomp(my @file = <FILE>); 373 close FILE; 374 375 open(BAK, "tmpswitches.bak") or die "$0: Failed to open 'tmpswitches.bak': $!"; 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"); 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 => ['tmpswitches'], 403 ); 404 is($out2, "", "no warning when files given"); 405 406 open my $f, ">", "tmpswitches" or die "$0: failed to create 'tmpswitches': $!"; 407 print $f "foo\nbar\n"; 408 close $f; 409 410 # a backup extension is no longer required on any platform 411 my $out3 = runperl( 412 switches => [ '-i', '-p' ], 413 prog => 's/foo/quux/', 414 stderr => 1, 415 args => [ 'tmpswitches' ], 416 ); 417 is($out3, "", "no warnings/errors without backup extension"); 418 open $f, "<", "tmpswitches" or die "$0: cannot open 'tmpswitches': $!"; 419 chomp(my @out4 = <$f>); 420 close $f; 421 is(join(":", @out4), "quux:bar", "correct output without backup extension"); 422 423 eval { require File::Spec; 1 } 424 or skip "Cannot load File::Spec - miniperl?", 20; 425 426 my $tmpinplace = tempfile(); 427 428 require File::Path; 429 END { 430 File::Path::rmtree($tmpinplace) 431 if $tmpinplace && -d $tmpinplace; 432 } 433 434 # test.pl's tempfile() doesn't create the file so we can 435 # safely mkdir it 436 mkdir $tmpinplace 437 or die "Cannot create $tmpinplace: $!"; 438 439 my $work = File::Spec->catfile($tmpinplace, "foo"); 440 441 # exit or die should leave original content in file 442 for my $inplace (qw/-i -i.bak/) { 443 for my $prog ("die", "exit 1") { 444 open my $fh, ">", $work or die "$0: failed to open '$work': $!"; 445 print $fh $yada; 446 close $fh or die "Failed to close: $!"; 447 my $out = runperl ( 448 switches => [ $inplace, '-n' ], 449 prog => "print q(foo\n); $prog", 450 stderr => 1, 451 args => [ $work ], 452 ); 453 open my $in, "<", $work or die "$0: failed to open '$work': $!"; 454 my $data = do { local $/; <$in> }; 455 close $in; 456 is ($data, $yada, "check original content still in file"); 457 unlink $work, "$work.bak"; 458 } 459 } 460 461 # test that path parsing is correct 462 open $f, ">", $work or die "Cannot create $work: $!"; 463 print $f "foo\nbar\n"; 464 close $f; 465 466 my $out4 = runperl 467 ( 468 switches => [ "-i", "-p" ], 469 prog => 's/foo/bar/', 470 stderr => 1, 471 args => [ $work ], 472 ); 473 is ($out4, "", "no errors or warnings"); 474 open $f, "<", $work or die "Cannot open $work: $!"; 475 chomp(my @file4 = <$f>); 476 close $f; 477 is(join(":", @file4), "bar:bar", "check output"); 478 479 SKIP: 480 { 481 # this needs to match how ARGV_USE_ATFUNCTIONS is defined in doio.c 482 skip "Not enough *at functions", 3 483 unless $Config{d_unlinkat} && $Config{d_renameat} && $Config{d_fchmodat} 484 && ($Config{d_dirfd} || $Config{d_dir_dd_fd}) 485 && $Config{d_linkat} 486 && $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/; 487 my ($osvers) = ($Config{osvers} =~ /^(\d+(?:\.\d+)?)/); 488 skip "NetBSD 6 libc defines at functions, but they're incomplete", 3 489 if $^O eq "netbsd" && $osvers < 7; 490 my $code = <<'CODE'; 491@ARGV = ("tmpinplace/foo"); 492$^I = ""; 493while (<>) { 494 chdir ".."; 495 print "xx\n"; 496} 497print "ok\n"; 498CODE 499 $code =~ s/tmpinplace/$tmpinplace/; 500 fresh_perl_is($code, "ok\n", { }, 501 "chdir while in-place editing"); 502 ok(open(my $fh, "<", $work), "open out file"); 503 is(scalar <$fh>, "xx\n", "file successfully saved after chdir"); 504 close $fh; 505 } 506 507 SKIP: 508 { 509 skip "Need threads and full perl", 3 510 if !$Config{useithreads} || is_miniperl(); 511 512 my $code = <<'CODE'; 513use threads; 514use strict; 515@ARGV = ("tmpinplace/foo"); 516$^I = ""; 517while (<>) { 518 threads->create(sub { })->join; 519 print "yy\n"; 520} 521print "ok\n"; 522CODE 523 $code =~ s/tmpinplace/$tmpinplace/; 524 fresh_perl_is($code, "ok\n", { stderr => 1 }, 525 "threads while in-place editing"); 526 ok(open(my $fh, "<", $work), "open out file"); 527 is(scalar <$fh>, "yy\n", "file successfully saved after chdir"); 528 close $fh; 529 } 530 531 SKIP: 532 { 533 skip "Need fork", 3 if !$Config{d_fork}; 534 open my $fh, ">", $work 535 or die "Cannot open $work: $!"; 536 # we want only a single line for this test, otherwise 537 # it attempts to close the file twice 538 print $fh "foo\n"; 539 close $fh or die "Cannot close $work: $!"; 540 my $code = <<'CODE'; 541use strict; 542@ARGV = ("tmpinplace/foo"); 543$^I = ""; 544while (<>) { 545 my $pid = fork; 546 if (defined $pid && !$pid) { 547 # child 548 close ARGVOUT or die "Cannot close in child\n"; # this shouldn't do ARGVOUT magic 549 exit 0; 550 } 551 wait; 552 print "yy\n"; 553 close ARGVOUT or die "Cannot close in parent\n"; # this should 554} 555print "ok\n"; 556CODE 557 $code =~ s/tmpinplace/$tmpinplace/; 558 fresh_perl_is($code, "ok\n", { stderr => 1 }, 559 "fork while in-place editing"); 560 ok(open($fh, "<", $work), "open out file"); 561 is(scalar <$fh>, "yy\n", "file successfully saved after fork"); 562 close $fh; 563 } 564 565 { 566 # test we handle the rename to the backup failing 567 if ($^O eq 'VMS') { 568 # make it fail by creating a .bak file with a version than which no higher can be created 569 # can't make a directory because foo.bak and foo^.bak.DIR do not conflict. 570 open my $fh, '>', "$work.bak;32767" or die "Cannot make mask backup file: $!"; 571 close $fh or die "Failed to close: $!"; 572 } 573 else { 574 # make it fail by creating a directory of the backup name 575 mkdir "$work.bak" or die "Cannot make mask backup directory: $!"; 576 } 577 my $code = <<'CODE'; 578@ARGV = ("tmpinplace/foo"); 579$^I = ".bak"; 580while (<>) { 581 print; 582} 583print "ok\n"; 584CODE 585 $code =~ s/tmpinplace/$tmpinplace/; 586 fresh_perl_like($code, qr/Can't rename/, { stderr => 1 }, "fail backup rename"); 587 if ($^O eq 'VMS') { 588 1 while unlink "$work.bak"; 589 } 590 else { 591 rmdir "$work.bak" or die "Cannot remove mask backup directory: $!"; 592 } 593 } 594 595 { 596 # test with absolute paths, this was failing on FreeBSD 11ish due 597 # to a bug in renameat() 598 my $abs_work = File::Spec->rel2abs($work); 599 fresh_perl_is(<<'CODE', "", 600while (<>) { 601 print; 602} 603CODE 604 { stderr => 1, args => [ $abs_work ], switches => [ "-i" ] }, 605 "abs paths"); 606 } 607 608 # we now use temp files for in-place editing, make sure we didn't leave 609 # any behind in the above test 610 opendir my $d, $tmpinplace or die "Cannot opendir $tmpinplace: $!"; 611 my @names = grep !/^\.\.?$/ && $_ ne 'foo' && $_ ne 'foo.', readdir $d; 612 closedir $d; 613 is(scalar(@names), 0, "no extra files") 614 or diag "Found @names, expected none"; 615 616 # the following tests might leave work files behind 617 618 # this test can leave the work file in the directory, since making 619 # the directory non-writable also prevents removing the work file 620 SKIP: 621 { 622 # test we handle the rename of the work to the original failing 623 # make it fail by removing write perms from the directory 624 # but first check that doesn't prevent writing 625 chmod 0500, $tmpinplace; 626 my $check = File::Spec->catfile($tmpinplace, "check"); 627 my $canwrite = open my $fh, ">", $check; 628 unlink $check; 629 chmod 0700, $tmpinplace or die "Cannot make $tmpinplace writable again: $!"; 630 skip "Cannot make $tmpinplace read only", 1 631 if $canwrite; 632 my $code = <<'CODE'; 633@ARGV = ("tmpinplace/foo"); 634$^I = ""; 635while (<>) { 636 chmod 0500, "tmpinplace"; 637 print; 638} 639print "ok\n"; 640CODE 641 $code =~ s/tmpinplace/$tmpinplace/g; 642 fresh_perl_like($code, qr/failed to rename/, { stderr => 1 }, "fail final rename"); 643 chmod 0700, $tmpinplace or die "Cannot make $tmpinplace writable again: $!"; 644 } 645 646 SKIP: 647 { 648 # this needs to reverse match how ARGV_USE_ATFUNCTIONS is defined in doio.c 649 skip "Testing without *at functions", 1 650 if $Config{d_unlinkat} && $Config{d_renameat} && $Config{d_fchmodat} 651 && ($Config{d_dirfd} || $Config{d_dir_dd_fd}) 652 && $Config{d_linkat} 653 && $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/; 654 my $code = <<'CODE'; 655@ARGV = ("tmpinplace/foo"); 656$^I = ""; 657while (<>) { 658 chdir ".."; 659 print "xx\n"; 660} 661print "ok\n"; 662CODE 663 $code =~ s/tmpinplace/$tmpinplace/; 664 fresh_perl_like($code, qr/^Cannot complete in-place edit of \Q$tmpinplace\E\/foo: .* - line 5, <> line \d+\./, { }, 665 "chdir while in-place editing (no at-functions)"); 666 } 667 668 unlink $work; 669 670 opendir $d, $tmpinplace or die "Cannot opendir $tmpinplace: $!"; 671 @names = grep !/^\.\.?$/ && !/foo$/aai, readdir $d; 672 closedir $d; 673 674 # clean up in case the above failed 675 unlink map File::Spec->catfile($tmpinplace, $_), @names; 676 677 rmdir $tmpinplace; 678 undef $tmpinplace; 679} 680 681# Tests for -E 682 683$TODO = ''; # the -E tests work on VMS 684 685$r = runperl( 686 switches => [ '-E', '"say q(Hello, world!)"'] 687); 688is( $r, "Hello, world!\n", "-E say" ); 689 690 691$r = runperl( 692 switches => [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"'] 693); 694is( $r, "Hello, world!\n", "-E ~~" ); 695 696$r = runperl( 697 switches => [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}'] 698); 699is( $r, "Hello, world!\n", "-E given" ); 700 701$r = runperl( 702 switches => [ '-nE', q("} END { say q/affe/") ], 703 stdin => 'zomtek', 704); 705is( $r, "affe\n", '-E works outside of the block created by -n' ); 706 707$r = runperl( 708 switches => [ '-E', q("*{'bar'} = sub{}; print 'Hello, world!',qq|\n|;")] 709); 710is( $r, "Hello, world!\n", "-E does not enable strictures" ); 711 712# RT #30660 713 714$filename = tempfile(); 715SKIP: { 716 open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); 717 print $f <<'SWTEST'; 718#!perl -w -iok 719print "$^I\n"; 720SWTEST 721 close $f or die "Could not close: $!"; 722 $r = runperl( 723 progfile => $filename, 724 ); 725 like( $r, qr/ok/, 'Spaces on the #! line (#30660)' ); 726} 727