Test that all the unknown command line flags are unknown.

[p5sagit/p5-mst-13.2.git] / t / run / switches.t

diff --git a/t/run/switches.t b/t/run/switches.t
index 35317ca..7312e1e 100644 (file)
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -1,6 +1,7 @@
 #!./perl -w
 
-# Tests for the command-line switches -0, -c, -l, -s, -m, -M, -V, -v
+# Tests for the command-line switches:
+# -0, -c, -l, -s, -m, -M, -V, -v, -h, -i, -E and all unknown
 # Some switches have their own tests, see MANIFEST.
 
 BEGIN {
@@ -8,9 +9,11 @@ BEGIN {
     @INC = '../lib';
 }
 
-require "./test.pl";
+BEGIN { require "./test.pl"; }
 
-plan(tests => 22);
+plan(tests => 62);
+
+use Config;
 
 # 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 
@@ -122,11 +125,27 @@ $r = runperl(
 );
 is( $r, '21-', '-s switch parsing' );
 
-# Bug ID 20011106.084
 $filename = 'swstest.tmp';
 SKIP: {
     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
     print $f <<'SWTEST';
+#!perl -s
+BEGIN { print $x,$y; exit }
+SWTEST
+    close $f or die "Could not close: $!";
+    $r = runperl(
+       progfile    => $filename,
+       args        => [ '-x=foo -y' ],
+    );
+    is( $r, 'foo1', '-s on the shebang line' );
+    push @tmpfiles, $filename;
+}
+
+# Bug ID 20011106.084
+$filename = 'swsntest.tmp';
+SKIP: {
+    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+    print $f <<'SWTEST';
 #!perl -sn
 BEGIN { print $x; exit }
 SWTEST
@@ -135,7 +154,7 @@ SWTEST
        progfile    => $filename,
        args        => [ '-x=foo' ],
     );
-    is( $r, 'foo', '-s on the shebang line' );
+    is( $r, 'foo', '-sn on the shebang line' );
     push @tmpfiles, $filename;
 }
 
@@ -216,12 +235,91 @@ SWTESTPM
 {
     local $TODO = '';   # these ones should work on VMS
 
-    # basic perl -V should generate significant output.
-    # we don't test actual format since it could change
     my $v = sprintf "%vd", $^V;
-    use Config;
     like( runperl( switches => ['-v'] ),
-         qr/This is perl, v$v built for $Config{archname}.+Copyright.+Larry Wall.+Artistic License.+GNU General Public License/s,
+         qr/This is perl, v$v (?:DEVEL\d+ )?built for \Q$Config{archname}\E.+Copyright.+Larry Wall.+Artistic License.+GNU General Public License/s,
           '-v looks okay' );
 
 }
+
+# Tests for -h
+
+{
+    local $TODO = '';   # these ones should work on VMS
+
+    like( runperl( switches => ['-h'] ),
+         qr/Usage: .+(?i:perl(?:$Config{_exe})?).+switches.+programfile.+arguments/,
+          '-h looks okay' );
+
+}
+
+# Tests for switches which do not exist
+
+foreach my $switch (split //, "ABbGgHJjKkLNOoQqRrYyZz123456789_")
+{
+    local $TODO = '';   # these ones should work on VMS
+
+    like( runperl( switches => ["-$switch"], stderr => 1,
+                  prog => 'die "oops"' ),
+         qr/\QUnrecognized switch: -$switch  (-h will show valid options)./,
+          "-$switch correctly unknown" );
+
+}
+
+# Tests for -i
+
+{
+    local $TODO = '';   # these ones should work on VMS
+
+    sub do_i_unlink { 1 while unlink("file", "file.bak") }
+
+    open(FILE, ">file") or die "$0: Failed to create 'file': $!";
+    print FILE <<__EOF__;
+foo yada dada
+bada foo bing
+king kong foo
+__EOF__
+    close FILE;
+
+    END { do_i_unlink() }
+
+    runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['file'] );
+
+    open(FILE, "file") or die "$0: Failed to open 'file': $!";
+    chomp(my @file = <FILE>);
+    close FILE;
+
+    open(BAK, "file.bak") or die "$0: Failed to open 'file': $!";
+    chomp(my @bak = <BAK>);
+    close BAK;
+
+    is(join(":", @file),
+       "bar yada dada:bada bar bing:king kong bar",
+       "-i new file");
+    is(join(":", @bak),
+       "foo yada dada:bada foo bing:king kong foo",
+       "-i backup file");
+}
+
+# Tests for -E
+
+$r = runperl(
+    switches   => [ '-E', '"say q(Hello, world!)"']
+);
+is( $r, "Hello, world!\n", "-E say" );
+
+
+$r = runperl(
+    switches   => [ '-E', '"undef err say q(Hello, world!)"']
+);
+is( $r, "Hello, world!\n", "-E err" );
+
+$r = runperl(
+    switches   => [ '-E', '"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!)"}}']
+);
+is( $r, "Hello, world!\n", "-E given" );