1N/A#!./perl -w
1N/A
1N/A# Tests for the command-line switches:
1N/A# -0, -c, -l, -s, -m, -M, -V, -v, -h, -z, -i
1N/A# Some switches have their own tests, see MANIFEST.
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/Arequire "./test.pl";
1N/A
1N/Aplan(tests => 26);
1N/A
1N/Ause Config;
1N/A
1N/A# due to a bug in VMS's piping which makes it impossible for runperl()
1N/A# to emulate echo -n (ie. stdin always winds up with a newline), these
1N/A# tests almost totally fail.
1N/A$TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS';
1N/A
1N/Amy $r;
1N/Amy @tmpfiles = ();
1N/AEND { unlink @tmpfiles }
1N/A
1N/A# Tests for -0
1N/A
1N/A$r = runperl(
1N/A switches => [ '-0', ],
1N/A stdin => 'foo\0bar\0baz\0',
1N/A prog => 'print qq(<$_>) while <>',
1N/A);
1N/Ais( $r, "<foo\0><bar\0><baz\0>", "-0" );
1N/A
1N/A$r = runperl(
1N/A switches => [ '-l', '-0', '-p' ],
1N/A stdin => 'foo\0bar\0baz\0',
1N/A prog => '1',
1N/A);
1N/Ais( $r, "foo\nbar\nbaz\n", "-0 after a -l" );
1N/A
1N/A$r = runperl(
1N/A switches => [ '-0', '-l', '-p' ],
1N/A stdin => 'foo\0bar\0baz\0',
1N/A prog => '1',
1N/A);
1N/Ais( $r, "foo\0bar\0baz\0", "-0 before a -l" );
1N/A
1N/A$r = runperl(
1N/A switches => [ sprintf("-0%o", ord 'x') ],
1N/A stdin => 'fooxbarxbazx',
1N/A prog => 'print qq(<$_>) while <>',
1N/A);
1N/Ais( $r, "<foox><barx><bazx>", "-0 with octal number" );
1N/A
1N/A$r = runperl(
1N/A switches => [ '-00', '-p' ],
1N/A stdin => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
1N/A prog => 's/\n/-/g;$_.=q(/)',
1N/A);
1N/Ais( $r, 'abc-def--/ghi-jkl-mno--/pq-/', '-00 (paragraph mode)' );
1N/A
1N/A$r = runperl(
1N/A switches => [ '-0777', '-p' ],
1N/A stdin => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
1N/A prog => 's/\n/-/g;$_.=q(/)',
1N/A);
1N/Ais( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' );
1N/A
1N/A$r = runperl(
1N/A switches => [ '-066' ],
1N/A prog => 'BEGIN { print qq{($/)} } print qq{[$/]}',
1N/A);
1N/Ais( $r, "(\066)[\066]", '$/ set at compile-time' );
1N/A
1N/A# Tests for -c
1N/A
1N/Amy $filename = 'swctest.tmp';
1N/ASKIP: {
1N/A local $TODO = ''; # this one works on VMS
1N/A
1N/A open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
1N/A print $f <<'SWTEST';
1N/ABEGIN { print "block 1\n"; }
1N/ACHECK { print "block 2\n"; }
1N/AINIT { print "block 3\n"; }
1N/A print "block 4\n";
1N/AEND { print "block 5\n"; }
1N/ASWTEST
1N/A close $f or die "Could not close: $!";
1N/A $r = runperl(
1N/A switches => [ '-c' ],
1N/A progfile => $filename,
1N/A stderr => 1,
1N/A );
1N/A # Because of the stderr redirection, we can't tell reliably the order
1N/A # in which the output is given
1N/A ok(
1N/A $r =~ /$filename syntax OK/
1N/A && $r =~ /\bblock 1\b/
1N/A && $r =~ /\bblock 2\b/
1N/A && $r !~ /\bblock 3\b/
1N/A && $r !~ /\bblock 4\b/
1N/A && $r !~ /\bblock 5\b/,
1N/A '-c'
1N/A );
1N/A push @tmpfiles, $filename;
1N/A}
1N/A
1N/A# Tests for -l
1N/A
1N/A$r = runperl(
1N/A switches => [ sprintf("-l%o", ord 'x') ],
1N/A prog => 'print for qw/foo bar/'
1N/A);
1N/Ais( $r, 'fooxbarx', '-l with octal number' );
1N/A
1N/A# Tests for -s
1N/A
1N/A$r = runperl(
1N/A switches => [ '-s' ],
1N/A prog => 'for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}',
1N/A args => [ '--', '-abc=2', '-def', ],
1N/A);
1N/Ais( $r, '21-', '-s switch parsing' );
1N/A
1N/A# Bug ID 20011106.084
1N/A$filename = 'swstest.tmp';
1N/ASKIP: {
1N/A open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
1N/A print $f <<'SWTEST';
1N/A#!perl -sn
1N/ABEGIN { print $x; exit }
1N/ASWTEST
1N/A close $f or die "Could not close: $!";
1N/A $r = runperl(
1N/A progfile => $filename,
1N/A args => [ '-x=foo' ],
1N/A );
1N/A is( $r, 'foo', '-s on the shebang line' );
1N/A push @tmpfiles, $filename;
1N/A}
1N/A
1N/A# Tests for -m and -M
1N/A
1N/A$filename = 'swtest.pm';
1N/ASKIP: {
1N/A open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
1N/A print $f <<'SWTESTPM';
1N/Apackage swtest;
1N/Asub import { print map "<$_>", @_ }
1N/A1;
1N/ASWTESTPM
1N/A close $f or die "Could not close: $!";
1N/A $r = runperl(
1N/A switches => [ '-Mswtest' ],
1N/A prog => '1',
1N/A );
1N/A is( $r, '<swtest>', '-M' );
1N/A $r = runperl(
1N/A switches => [ '-Mswtest=foo' ],
1N/A prog => '1',
1N/A );
1N/A is( $r, '<swtest><foo>', '-M with import parameter' );
1N/A $r = runperl(
1N/A switches => [ '-mswtest' ],
1N/A prog => '1',
1N/A );
1N/A
1N/A {
1N/A local $TODO = ''; # this one works on VMS
1N/A is( $r, '', '-m' );
1N/A }
1N/A $r = runperl(
1N/A switches => [ '-mswtest=foo,bar' ],
1N/A prog => '1',
1N/A );
1N/A is( $r, '<swtest><foo><bar>', '-m with import parameters' );
1N/A push @tmpfiles, $filename;
1N/A}
1N/A
1N/A# Tests for -V
1N/A
1N/A{
1N/A local $TODO = ''; # these ones should work on VMS
1N/A
1N/A # basic perl -V should generate significant output.
1N/A # we don't test actual format too much since it could change
1N/A like( runperl( switches => ['-V'] ), qr/(\n.*){20}/,
1N/A '-V generates 20+ lines' );
1N/A
1N/A like( runperl( switches => ['-V'] ),
1N/A qr/\ASummary of my perl5 .*configuration:/,
1N/A '-V looks okay' );
1N/A
1N/A # lookup a known config var
1N/A chomp( $r=runperl( switches => ['-V:osname'] ) );
1N/A is( $r, "osname='$^O';", 'perl -V:osname');
1N/A
1N/A # lookup a nonexistent var
1N/A chomp( $r=runperl( switches => ['-V:this_var_makes_switches_test_fail'] ) );
1N/A is( $r, "this_var_makes_switches_test_fail='UNKNOWN';",
1N/A 'perl -V:unknown var');
1N/A
1N/A # regexp lookup
1N/A # platforms that don't like this quoting can either skip this test
1N/A # or fix test.pl _quote_args
1N/A $r = runperl( switches => ['"-V:i\D+size"'] );
1N/A # should be unlike( $r, qr/^$|not found|UNKNOWN/ );
1N/A like( $r, qr/^(?!.*(not found|UNKNOWN))./, 'perl -V:re got a result' );
1N/A
1N/A # make sure each line we got matches the re
1N/A ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' );
1N/A}
1N/A
1N/A# Tests for -v
1N/A
1N/A{
1N/A local $TODO = ''; # these ones should work on VMS
1N/A
1N/A my $v = sprintf "%vd", $^V;
1N/A like( runperl( switches => ['-v'] ),
1N/A qr/This is perl, v$v built for $Config{archname}.+Copyright.+Larry Wall.+Artistic License.+GNU General Public License/s,
1N/A '-v looks okay' );
1N/A
1N/A}
1N/A
1N/A# Tests for -h
1N/A
1N/A{
1N/A local $TODO = ''; # these ones should work on VMS
1N/A
1N/A like( runperl( switches => ['-h'] ),
1N/A qr/Usage: .+(?i:perl(?:$Config{_exe})?).+switches.+programfile.+arguments/,
1N/A '-h looks okay' );
1N/A
1N/A}
1N/A
1N/A# Tests for -z (which does not exist)
1N/A
1N/A{
1N/A local $TODO = ''; # these ones should work on VMS
1N/A
1N/A like( runperl( switches => ['-z'], stderr => 1 ),
1N/A qr/\QUnrecognized switch: -z (-h will show valid options)./,
1N/A '-z correctly unknown' );
1N/A
1N/A}
1N/A
1N/A# Tests for -i
1N/A
1N/A{
1N/A local $TODO = ''; # these ones should work on VMS
1N/A
1N/A sub do_i_unlink { 1 while unlink("file", "file.bak") }
1N/A
1N/A open(FILE, ">file") or die "$0: Failed to create 'file': $!";
1N/A print FILE <<__EOF__;
1N/Afoo yada dada
1N/Abada foo bing
1N/Aking kong foo
1N/A__EOF__
1N/A close FILE;
1N/A
1N/A END { do_i_unlink() }
1N/A
1N/A runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['file'] );
1N/A
1N/A open(FILE, "file") or die "$0: Failed to open 'file': $!";
1N/A chomp(my @file = <FILE>);
1N/A close FILE;
1N/A
1N/A open(BAK, "file.bak") or die "$0: Failed to open 'file': $!";
1N/A chomp(my @bak = <BAK>);
1N/A close BAK;
1N/A
1N/A is(join(":", @file),
1N/A "bar yada dada:bada bar bing:king kong bar",
1N/A "-i new file");
1N/A is(join(":", @bak),
1N/A "foo yada dada:bada foo bing:king kong foo",
1N/A "-i backup file");
1N/A}