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