#!./perl -w
-# Tests for the command-line switches
+# 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 {
chdir 't' if -d 't';
@INC = '../lib';
}
-require "./test.pl";
+BEGIN { require "./test.pl"; }
-plan(tests => 20);
+plan(tests => 71);
+
+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
$r = runperl(
switches => [ '-066' ],
- prog => 'BEGIN { print "($/)" } print "[$/]"',
+ prog => 'BEGIN { print qq{($/)} } print qq{[$/]}',
);
is( $r, "(\066)[\066]", '$/ set at compile-time' );
# Tests for -c
-my $filename = 'swctest.tmp';
+my $filename = tempfile();
SKIP: {
local $TODO = ''; # this one works on VMS
&& $r !~ /\bblock 5\b/,
'-c'
);
- push @tmpfiles, $filename;
}
# Tests for -l
);
is( $r, '21-', '-s switch parsing' );
-# Bug ID 20011106.084
-$filename = 'swstest.tmp';
+$filename = tempfile();
SKIP: {
open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
print $f <<'SWTEST';
#!perl -s
-print $x
+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' );
+}
+
+# Bug ID 20011106.084
+$filename = tempfile();
+SKIP: {
+ open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+ print $f <<'SWTEST';
+#!perl -sn
+BEGIN { print $x; exit }
SWTEST
close $f or die "Could not close: $!";
$r = runperl(
- switches => [ '-s' ],
progfile => $filename,
args => [ '-x=foo' ],
);
- is( $r, 'foo', '-s on the shebang line' );
- push @tmpfiles, $filename;
+ is( $r, 'foo', '-sn on the shebang line' );
}
# Tests for -m and -M
-$filename = 'swtest.pm';
+my $package = tempfile();
+$filename = "$package.pm";
SKIP: {
open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
- print $f <<'SWTESTPM';
-package swtest;
-sub import { print map "<$_>", @_ }
+ print $f <<"SWTESTPM";
+package $package;
+sub import { print map "<\$_>", \@_ }
1;
SWTESTPM
close $f or die "Could not close: $!";
$r = runperl(
- switches => [ '-Mswtest' ],
+ switches => [ "-M$package" ],
prog => '1',
);
- is( $r, '<swtest>', '-M' );
+ is( $r, "<$package>", '-M' );
$r = runperl(
- switches => [ '-Mswtest=foo' ],
+ switches => [ "-M$package=foo" ],
prog => '1',
);
- is( $r, '<swtest><foo>', '-M with import parameter' );
+ is( $r, "<$package><foo>", '-M with import parameter' );
$r = runperl(
- switches => [ '-mswtest' ],
+ switches => [ "-m$package" ],
prog => '1',
);
is( $r, '', '-m' );
}
$r = runperl(
- switches => [ '-mswtest=foo,bar' ],
+ switches => [ "-m$package=foo,bar" ],
prog => '1',
);
- is( $r, '<swtest><foo><bar>', '-m with import parameters' );
+ is( $r, "<$package><foo><bar>", '-m with import parameters' );
push @tmpfiles, $filename;
+
+ {
+ local $TODO = ''; # these work on VMS
+
+ is( runperl( switches => [ '-MTie::Hash' ], stderr => 1, prog => 1 ),
+ '', "-MFoo::Bar allowed" );
+
+ like( runperl( switches => [ "-M:$package" ], stderr => 1,
+ prog => 'die "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"' ),
+ 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"' ),
+ qr/Invalid module name [\w:]+ with -m option\b/,
+ "-m-Foo:Bar not allowed" );
+
+ like( runperl( switches => [ '-m-' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Module name required with -m option\b/,
+ "-m- not allowed" );
+
+ like( runperl( switches => [ '-M-=' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Module name required with -M option\b/,
+ "-M- not allowed" );
+ } # disable TODO on VMS
}
# Tests for -V
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
+ # we don't test actual format too much since it could change
like( runperl( switches => ['-V'] ), qr/(\n.*){20}/,
'-V generates 20+ lines' );
+ like( runperl( switches => ['-V'] ),
+ qr/\ASummary of my perl5 .*configuration:/,
+ '-V looks okay' );
+
# lookup a known config var
chomp( $r=runperl( switches => ['-V:osname'] ) );
is( $r, "osname='$^O';", 'perl -V:osname');
# make sure each line we got matches the re
ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' );
}
+
+# Tests for -v
+
+{
+ local $TODO = ''; # these ones should work on VMS
+ # there are definitely known build configs where this test will fail
+ # DG/UX comes to mind. Maybe we should remove these special cases?
+ my $v = sprintf "%vd", $^V;
+ like( runperl( switches => ['-v'] ),
+ qr/This is perl, v\Q$v\E(?:[-*\w]+| \([^)]+\))? 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 //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_")
+{
+ 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
+
+$TODO = ''; # the -E tests work on VMS
+
+$r = runperl(
+ switches => [ '-E', '"say q(Hello, world!)"']
+);
+is( $r, "Hello, world!\n", "-E say" );
+
+
+$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" );
+
+$r = runperl(
+ switches => [ '-nE', q("} END { say q/affe/") ],
+ stdin => 'zomtek',
+);
+is( $r, "affe\n", '-E works outside of the block created by -n' );
+
+$r = runperl(
+ switches => [ '-E', q("*{'bar'} = sub{}; print 'Hello, world!',qq|\n|;")]
+);
+is( $r, "Hello, world!\n", "-E does not enable strictures" );
+
+# RT #30660
+
+$filename = tempfile();
+SKIP: {
+ open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+ print $f <<'SWTEST';
+#!perl -w -iok
+print "$^I\n";
+SWTEST
+ close $f or die "Could not close: $!";
+ $r = runperl(
+ progfile => $filename,
+ );
+ like( $r, qr/ok/, 'Spaces on the #! line (#30660)' );
+}
projects / p5sagit/p5-mst-13.2.git / blobdiff