new tests for command-line switches

Message-ID: <20011115170030.A14193@rafael>

p4raw-id: //depot/perl@13022

diff --git a/MANIFEST b/MANIFEST
index b7d7026..e83e681 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2276,6 +2276,7 @@ t/run/switchp.t                   Test the -p switch
 t/run/switchn.t                        Test the -n switch
 t/run/switcha.t                        Test the -a switch
 t/run/switchF.t                        Test the -F switch
+t/run/switches.t               Tests for the other switches
 t/TEST                         The regression tester
 t/test.pl                      Simple testing library
 t/TestInit.pm                  Preamble library for core tests

diff --git a/t/run/switches.t b/t/run/switches.t
new file mode 100644 (file)
index 0000000..2d6645d
--- /dev/null
+++ b/t/run/switches.t
@@ -0,0 +1,182 @@
+#!./perl -w
+
+# Tests for the command-line switches
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+require "./test.pl";
+
+plan(tests => 15);
+
+my $r;
+my @tmpfiles = ();
+END { unlink @tmpfiles }
+
+# Tests for -0
+
+$r = runperl(
+    switches   => [ '-0', ],
+    stdin      => 'foo\0bar\0baz\0',
+    prog       => 'print qq(<$_>) while <>',
+);
+is( $r, "<foo\0><bar\0><baz\0>", "-0" );
+
+$r = runperl(
+    switches   => [ '-l', '-0', '-p' ],
+    stdin      => 'foo\0bar\0baz\0',
+    prog       => '1',
+);
+is( $r, "foo\nbar\nbaz\n", "-0 after a -l" );
+
+$r = runperl(
+    switches   => [ '-0', '-l', '-p' ],
+    stdin      => 'foo\0bar\0baz\0',
+    prog       => '1',
+);
+is( $r, "foo\0bar\0baz\0", "-0 before a -l" );
+
+$r = runperl(
+    switches   => [ sprintf("-0%o", ord 'x') ],
+    stdin      => 'fooxbarxbazx',
+    prog       => 'print qq(<$_>) while <>',
+);
+is( $r, "<foox><barx><bazx>", "-0 with octal number" );
+
+$r = runperl(
+    switches   => [ '-00', '-p' ],
+    stdin      => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
+    prog       => 's/\n/-/g;$_.=q(/)',
+);
+is( $r, 'abc-def--/ghi-jkl-mno--/pq-/', '-00 (paragraph mode)' );
+
+$r = runperl(
+    switches   => [ '-0777', '-p' ],
+    stdin      => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
+    prog       => 's/\n/-/g;$_.=q(/)',
+);
+is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' );
+
+# Tests for -c
+
+my $filename = 'swctest.tmp';
+SKIP: {
+    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+    print $f <<'SWTEST';
+BEGIN { print "block 1\n"; }
+CHECK { print "block 2\n"; }
+INIT  { print "block 3\n"; }
+       print "block 4\n";
+END   { print "block 5\n"; }
+SWTEST
+    close $f;
+    $r = runperl(
+       switches        => [ '-c' ],
+       progfile        => $filename,
+       stderr          => 1,
+    );
+    # Because of the stderr redirection, we can't tell reliably the order
+    # in which the output is given
+    ok(
+       $r =~ /$filename syntax OK/
+       && $r =~ /\bblock 1\b/
+       && $r =~ /\bblock 2\b/
+       && $r !~ /\bblock 3\b/
+       && $r !~ /\bblock 4\b/
+       && $r !~ /\bblock 5\b/,
+       '-c'
+    );
+    push @tmpfiles, $filename;
+}
+
+# Tests for -l
+
+$r = runperl(
+    switches   => [ sprintf("-l%o", ord 'x') ],
+    prog       => 'print for qw/foo bar/'
+);
+is( $r, 'fooxbarx', '-l with octal number' );
+
+# Tests for -s
+
+$r = runperl(
+    switches   => [ '-s' ],
+    prog       => 'for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}',
+    args       => [ '--', '-abc=2', '-def', ],
+);
+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
+print $x
+SWTEST
+    close $f;
+    $r = runperl(
+       switches    => [ '-s' ],
+       progfile    => $filename,
+       args        => [ '-x=foo' ],
+    );
+    is( $r, 'foo', '-s on the #! line' );
+    push @tmpfiles, $filename;
+}
+
+# Tests for -m and -M
+
+$filename = 'swtest.pm';
+SKIP: {
+    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
+    print $f <<'SWTESTPM';
+package swtest;
+sub import { print map "<$_>", @_ }
+1;
+SWTESTPM
+    close $f;
+    $r = runperl(
+       switches    => [ '-Mswtest' ],
+       prog        => '1',
+    );
+    is( $r, '<swtest>', '-M' );
+    $r = runperl(
+       switches    => [ '-Mswtest=foo' ],
+       prog        => '1',
+    );
+    is( $r, '<swtest><foo>', '-M with import parameter' );
+    $r = runperl(
+       switches    => [ '-mswtest' ],
+       prog        => '1',
+    );
+    is( $r, '', '-m' );
+    $r = runperl(
+       switches    => [ '-mswtest=foo,bar' ],
+       prog        => '1',
+    );
+    is( $r, '<swtest><foo><bar>', '-m with import parameters' );
+    push @tmpfiles, $filename;
+}
+
+# Tests for -x
+
+$filename = 'swxtest.tmp';
+SKIP: {
+    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+    print $f <<'SWTEST';
+print 1;
+#!perl
+print 2;
+__END__
+print 3;
+SWTEST
+    close $f;
+    $r = runperl(
+       switches    => [ '-x' ],
+       progfile    => $filename,
+    );
+    is( $r, '2', '-x' );
+    push @tmpfiles, $filename;
+}