Report useful file names and line numbers from run_multiple_progs().

[perl5.git] / t / run / switches.t

diff --git a/t/run/switches.t b/t/run/switches.t
index 20cb772..f1b9234 100644 (file)
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -11,9 +11,11 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan(tests => 71);
+plan(tests => 115);
 
 use Config;
+use Errno qw(EACCES EISDIR);
+use POSIX qw(setlocale LC_ALL);
 
 # due to a bug in VMS's piping which makes it impossible for runperl()
 # to emulate echo -n (ie. stdin always winds up with a newline), these 
@@ -22,7 +24,7 @@ $TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS';
 
 my $r;
 my @tmpfiles = ();
-END { unlink @tmpfiles }
+END { unlink_all @tmpfiles }
 
 # Tests for -0
 
@@ -107,6 +109,25 @@ SWTEST
     );
 }
 
+{
+    my $tempdir = tempfile;
+    mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
+
+    local $ENV{'LC_ALL'} = 'C'; # Keep the test simple: expect English
+    local $ENV{LANGUAGE} = 'C';
+    setlocale(LC_ALL, "C");
+
+    # Win32 won't let us open the directory, so we never get to die with
+    # EISDIR, which happens after open.
+    my $error  = do { local $! = $^O eq 'MSWin32' ? EACCES : EISDIR; "$!" };
+    like(
+        runperl( switches => [ '-c' ], args  => [ $tempdir ], stderr => 1),
+        qr/Can't open perl script.*$tempdir.*\Q$error/s,
+        "RT \#61362: Cannot syntax-check a directory"
+    );
+    rmdir $tempdir or die "Can't rmdir '$tempdir': $!";
+}
+
 # Tests for -l
 
 $r = runperl(
@@ -200,31 +221,35 @@ SWTESTPM
          '', "-MFoo::Bar allowed" );
 
     like( runperl( switches => [ "-M:$package" ], stderr => 1,
-                  prog => 'die "oops"' ),
+                  prog => 'die q{oops}' ),
          qr/Invalid module name [\w:]+ with -M option\b/,
           "-M:Foo not allowed" );
 
     like( runperl( switches => [ '-mA:B:C' ], stderr => 1,
-                  prog => 'die "oops"' ),
+                  prog => 'die q{oops}' ),
          qr/Invalid module name [\w:]+ with -m option\b/,
           "-mFoo:Bar not allowed" );
 
     like( runperl( switches => [ '-m-A:B:C' ], stderr => 1,
-                  prog => 'die "oops"' ),
+                  prog => 'die q{oops}' ),
          qr/Invalid module name [\w:]+ with -m option\b/,
           "-m-Foo:Bar not allowed" );
 
     like( runperl( switches => [ '-m-' ], stderr => 1,
-                  prog => 'die "oops"' ),
+                  prog => 'die q{oops}' ),
          qr/Module name required with -m option\b/,
          "-m- not allowed" );
 
     like( runperl( switches => [ '-M-=' ], stderr => 1,
-                  prog => 'die "oops"' ),
+                  prog => 'die q{oops}' ),
          qr/Module name required with -M option\b/,
          "-M- not allowed" );
   }  # disable TODO on VMS
 }
+is runperl(stderr => 1, prog => '#!perl -m'),
+   qq 'Too late for "-m" option at -e line 1.\n', '#!perl -m';
+is runperl(stderr => 1, prog => '#!perl -M'),
+   qq 'Too late for "-M" option at -e line 1.\n', '#!perl -M';
 
 # Tests for -V
 
@@ -293,10 +318,24 @@ foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_")
     local $TODO = '';   # these ones should work on VMS
 
     like( runperl( switches => ["-$switch"], stderr => 1,
-                  prog => 'die "oops"' ),
+                  prog => 'die q{oops}' ),
          qr/\QUnrecognized switch: -$switch  (-h will show valid options)./,
           "-$switch correctly unknown" );
 
+    # [perl #104288]
+    like( runperl( stderr => 1, prog => "#!perl -$switch" ),
+         qr/^Unrecognized switch: -$switch  \(-h will show valid (?x:
+            )options\) at -e line 1\./,
+          "-$switch unrecognised on #! line" );
+}
+
+# Tests for unshebangable switches
+for (qw( e f x E S V )) {
+    $r = runperl(
+       stderr   => 1,
+       prog     => "#!perl -$_",
+    );
+    is $r, "Can't emulate -$_ on #! line at -e line 1.\n","-$_ on #! line";
 }
 
 # Tests for -i
@@ -304,7 +343,7 @@ foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_")
 {
     local $TODO = '';   # these ones should work on VMS
 
-    sub do_i_unlink { 1 while unlink("file", "file.bak") }
+    sub do_i_unlink { unlink_all("file", "file.bak") }
 
     open(FILE, ">file") or die "$0: Failed to create 'file': $!";
     print FILE <<__EOF__;
@@ -332,6 +371,26 @@ __EOF__
     is(join(":", @bak),
        "foo yada dada:bada foo bing:king kong foo",
        "-i backup file");
+
+    my $out1 = runperl(
+        switches => ['-i.bak -p'],
+        prog     => 'exit',
+        stderr   => 1,
+        stdin    => "1\n",
+    );
+    is(
+        $out1,
+        "-i used with no filenames on the command line, reading from STDIN.\n",
+        "warning when no files given"
+    );
+    my $out2 = runperl(
+        switches => ['-i.bak -p'],
+        prog     => 'exit',
+        stderr   => 1,
+        stdin    => "1\n",
+        args     => ['file'],
+    );
+    is($out2, "", "no warning when files given");
 }
 
 # Tests for -E
@@ -345,12 +404,12 @@ is( $r, "Hello, world!\n", "-E say" );
 
 
 $r = runperl(
-    switches   => [ '-E', '"undef ~~ undef and say q(Hello, world!)"']
+    switches   => [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"']
 );
 is( $r, "Hello, world!\n", "-E ~~" );
 
 $r = runperl(
-    switches   => [ '-E', '"given(undef) {when(undef) { say q(Hello, world!)"}}']
+    switches   => [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}']
 );
 is( $r, "Hello, world!\n", "-E given" );