summaryrefslogtreecommitdiff
path: root/t/op
diff options
context:
space:
mode:
Diffstat (limited to 't/op')
-rwxr-xr-xt/op/closure.t8
-rwxr-xr-xt/op/exec.t7
-rwxr-xr-xt/op/glob.t7
-rwxr-xr-xt/op/goto.t3
-rwxr-xr-xt/op/magic.t73
-rwxr-xr-xt/op/misc.t13
-rwxr-xr-xt/op/rand.t10
-rwxr-xr-xt/op/split.t3
-rwxr-xr-xt/op/stat.t40
-rwxr-xr-xt/op/sysio.t2
-rwxr-xr-xt/op/taint.t10
11 files changed, 115 insertions, 61 deletions
diff --git a/t/op/closure.t b/t/op/closure.t
index 7af3abb291..1220998b6b 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -377,7 +377,7 @@ END
$test++;
}
- if ($Config{d_fork} and $^O ne 'VMS') {
+ if ($Config{d_fork} and $^O ne 'VMS' and $^O ne 'MSWin32') {
# Fork off a new perl to run the tests.
# (This is so we can catch spurious warnings.)
$| = 1; print ""; $| = 0; # flush output before forking
@@ -411,9 +411,11 @@ END
my $errfile = "terr$$"; $errfile++ while -e $errfile;
my @tmpfiles = ($cmdfile, $errfile);
open CMD, ">$cmdfile"; print CMD $code; close CMD;
- my $cmd = ($^O eq 'VMS') ? "MCR $^X" : "./perl";
+ my $cmd = (($^O eq 'VMS') ? "MCR $^X"
+ : ($^O eq 'MSWin32') ? '.\perl'
+ : './perl');
$cmd .= " -w $cmdfile 2>$errfile";
- if ($^O eq 'VMS') {
+ if ($^O eq 'VMS' or $^O eq 'MSWin32') {
# Use pipe instead of system so we don't inherit STD* from
# this process, and then foul our pipe back to parent by
# redirecting output in the child.
diff --git a/t/op/exec.t b/t/op/exec.t
index 1103a1a464..7dfcd6177f 100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -3,6 +3,13 @@
# $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $
$| = 1; # flush stdout
+
+if ($^O eq 'MSWin32') {
+ print "# exec is unsupported on Win32\n";
+ print "1..0\n";
+ exit(0);
+}
+
print "1..8\n";
print "not ok 1\n" if system "echo ok \\1"; # shell interpreted
diff --git a/t/op/glob.t b/t/op/glob.t
index cc60a17a72..dd95e980d5 100755
--- a/t/op/glob.t
+++ b/t/op/glob.t
@@ -7,7 +7,12 @@ print "1..6\n";
@oops = @ops = <op/*>;
map { $files{$_}++ } <op/*>;
-map { delete $files{$_} } split /[\s\n]/, `echo op/*`;
+if ($^O eq 'MSWin32') {
+ map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op"`;
+}
+else {
+ map { delete $files{$_} } split /[\s\n]/, `echo op/*`;
+}
if (keys %files) {
print "not ok 1\t(",join(' ', sort keys %files),"\n";
} else { print "ok 1\n"; }
diff --git a/t/op/goto.t b/t/op/goto.t
index 087331907e..1b34acda39 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -31,7 +31,8 @@ label4:
print "#2\t:$foo: == 4\n";
if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
-$x = `./perl -e 'goto foo;' 2>&1`;
+$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
+$x = `$PERL -e "goto foo;" 2>&1`;
if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; }
if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/t/op/magic.t b/t/op/magic.t
index 70f2bec2c3..fa19716c14 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -19,10 +19,14 @@ sub ok {
}
}
+$Is_MSWin32 = ($^O eq 'MSWin32');
+$PERL = ($Is_MSWin32 ? '.\perl' : './perl');
+
print "1..28\n";
eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval
-ok 1, `echo \$foo` eq "hi there\n";
+if ($Is_MSWin32) { ok 1, `set foo` eq "foo=hi there\n"; }
+else { ok 1, `echo \$foo` eq "hi there\n"; }
unlink 'ajslkdfpqjsjfk';
$! = 0;
@@ -30,10 +34,14 @@ open(FOO,'ajslkdfpqjsjfk');
ok 2, $!, $!;
close FOO; # just mention it, squelch used-only-once
-# the next tests are embedded inside system simply because sh spits out
-# a newline onto stderr when a child process kills itself with SIGINT.
-
-system './perl', '-e', <<'END';
+if ($Is_MSWin32) {
+ ok 3,1;
+ ok 4,1;
+}
+else {
+ # the next tests are embedded inside system simply because sh spits out
+ # a newline onto stderr when a child process kills itself with SIGINT.
+ system './perl', '-e', <<'END';
$| = 1; # command buffering
@@ -51,8 +59,10 @@ system './perl', '-e', <<'END';
}
END
+}
-@val1 = @ENV{keys(%ENV)}; # can we slice ENV?
+# can we slice ENV?
+@val1 = @ENV{keys(%ENV)};
@val2 = values(%ENV);
ok 5, join(':',@val1) eq join(':',@val2);
ok 6, @val1 > 1;
@@ -84,9 +94,9 @@ ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0];
}
# $?, $@, $$
-system 'true';
+system "$PERL -e 'exit(0)'";
ok 15, $? == 0, $?;
-system 'false';
+system "$PERL -e 'exit(1)'";
ok 16, $? != 0, $?;
eval { die "foo\n" };
@@ -95,33 +105,38 @@ ok 17, $@ eq "foo\n", $@;
ok 18, $$ > 0, $$;
# $^X and $0
-if ($^O eq 'qnx' || $^O eq 'amigaos') {
- chomp($wd = `pwd`);
+if ($Is_MSWin32) {
+ for (19 .. 25) { ok $_, 1 }
}
else {
- $wd = '.';
-}
-$script = "$wd/show-shebang";
-$s1 = $s2 = "\$^X is $wd/perl, \$0 is $script\n";
-if ($^O eq 'os2') {
- # Started by ksh, which adds suffixes '.exe' and '.' to perl and script
- $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n";
-}
-ok 19, open(SCRIPT, ">$script"), $!;
-ok 20, print(SCRIPT <<EOB . <<'EOF'), $!;
+ if ($^O eq 'qnx' || $^O eq 'amigaos') {
+ chomp($wd = `pwd`);
+ }
+ else {
+ $wd = '.';
+ }
+ $script = "$wd/show-shebang";
+ $s1 = $s2 = "\$^X is $wd/perl, \$0 is $script\n";
+ if ($^O eq 'os2') {
+ # Started by ksh, which adds suffixes '.exe' and '.' to perl and script
+ $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n";
+ }
+ ok 19, open(SCRIPT, ">$script"), $!;
+ ok 20, print(SCRIPT <<EOB . <<'EOF'), $!;
#!$wd/perl
EOB
print "\$^X is $^X, \$0 is $0\n";
EOF
-ok 21, close(SCRIPT), $!;
-ok 22, chmod(0755, $script), $!;
-$_ = `$script`;
-s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
-s{is perl}{is $wd/perl}; # for systems where $^X is only a basename
-ok 23, $_ eq $s2, ":$_:!=:$s2:";
-$_ = `$wd/perl $script`;
-ok 24, $_ eq $s1, ":$_:!=:$s1: after `$wd/perl $script`";
-ok 25, unlink($script), $!;
+ ok 21, close(SCRIPT), $!;
+ ok 22, chmod(0755, $script), $!;
+ $_ = `$script`;
+ s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
+ s{is perl}{is $wd/perl}; # for systems where $^X is only a basename
+ ok 23, $_ eq $s2, ":$_:!=:$s2:";
+ $_ = `$wd/perl $script`;
+ ok 24, $_ eq $s1, ":$_:!=:$s1: after `$wd/perl $script`";
+ ok 25, unlink($script), $!;
+}
# $], $^O, $^T
ok 26, $] >= 5.00319, $];
diff --git a/t/op/misc.t b/t/op/misc.t
index 0f251ea354..02d32bd5c5 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -14,17 +14,24 @@ $tmpfile = "misctmp000";
1 while -f ++$tmpfile;
END { unlink $tmpfile if $tmpfile; }
+$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
+
for (@prgs){
my $switch;
if (s/^\s*-\w+//){
$switch = $&;
}
my($prog,$expected) = split(/\nEXPECT\n/, $_);
- open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+ if ($^O eq 'MSWin32') {
+ open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1";
+ }
+ else {
+ open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+ }
print TEST $prog, "\n";
close TEST;
$status = $?;
- $results = `cat $tmpfile`;
+ $results = `$CAT $tmpfile`;
$results =~ s/\n+$//;
$expected =~ s/\n+$//;
if ( $results ne $expected){
@@ -74,7 +81,7 @@ EXPECT
########
eval {sub bar {print "In bar";}}
########
-system "./perl -ne 'print if eof' /dev/null"
+system './perl -ne "print if eof" /dev/null'
########
chop($file = <>);
########
diff --git a/t/op/rand.t b/t/op/rand.t
index 4eeca6b10c..23a09b7388 100755
--- a/t/op/rand.t
+++ b/t/op/rand.t
@@ -329,12 +329,10 @@ AUTOSRAND:
my($pid, $first);
for (1..5) {
- if ($^O eq 'VMS') {
- $pid = open PERL, qq[MCR $^X -e "print rand"|];
- }
- else {
- $pid = open PERL, "./perl -e 'print rand'|";
- }
+ my $PERL = (($^O eq 'VMS') ? "MCR $^X"
+ : ($^O eq 'MSWin32') ? '.\perl'
+ : './perl');
+ $pid = open PERL, qq[$PERL -e "print rand"|];
die "Couldn't pipe from perl: $!" unless defined $pid;
if (defined $first) {
if ($first ne <PERL>) {
diff --git a/t/op/split.t b/t/op/split.t
index 4144bbb88f..90bb436550 100755
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -47,7 +47,8 @@ $_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999));
print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
# Does assignment to a list imply split to one more field than that?
-$foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
+if ($^O eq 'MSWin32') { $foo = `.\\perl -D1024 -e "(\$a,\$b) = split;" 2>&1` }
+else { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` }
if ($foo =~ /DCL-W-NOCOMD/) {
$foo = `\$ mcr sys\$disk:[]perl. "-D1024" -e "(\$a,\$b) = split;"`;
}
diff --git a/t/op/stat.t b/t/op/stat.t
index f0fd9a00b1..d7271522c2 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -13,14 +13,16 @@ use Config;
print "1..56\n";
-chop($cwd = `pwd`);
+$Is_MSWin32 = $^O eq 'MSWin32';
+chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
-$DEV = `ls -l /dev`;
+$DEV = `ls -l /dev` unless $Is_MSWin32;
unlink "Op.stat.tmp";
open(FOO, ">Op.stat.tmp");
-$junk = `ls Op.stat.tmp`; # hack to make Apollo update link count
+# hack to make Apollo update link count:
+$junk = `ls Op.stat.tmp` unless $Is_MSWin32;
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat(FOO);
@@ -86,7 +88,7 @@ if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
-if (`ls -l perl` =~ /^l.*->/) {
+if (!$Is_MSWin32 and `ls -l perl` =~ /^l.*->/) {
if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
}
else {
@@ -99,7 +101,9 @@ if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
`rm -f Op.stat.tmp Op.stat.tmp2`;
if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
-if ($DEV !~ /\nc.* (\S+)\n/)
+if ($Is_MSWin32)
+ {print "ok 29\n";}
+elsif ($DEV !~ /\nc.* (\S+)\n/)
{print "ok 29\n";}
elsif (-c "/dev/$1")
{print "ok 29\n";}
@@ -107,7 +111,9 @@ else
{print "not ok 29\n";}
if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
-if ($DEV !~ /\ns.* (\S+)\n/)
+if ($Is_MSWin32)
+ {print "ok 31\n";}
+elsif ($DEV !~ /\ns.* (\S+)\n/)
{print "ok 31\n";}
elsif (-S "/dev/$1")
{print "ok 31\n";}
@@ -115,7 +121,9 @@ else
{print "not ok 31\n";}
if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
-if ($DEV !~ /\nb.* (\S+)\n/)
+if ($Is_MSWin32)
+ {print "ok 33\n";}
+elsif ($DEV !~ /\nb.* (\S+)\n/)
{print "ok 33\n";}
elsif (-b "/dev/$1")
{print "ok 33\n";}
@@ -123,7 +131,7 @@ else
{print "not ok 33\n";}
if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
-if ($^O eq 'amigaos') {print "ok 35\n"; goto tty_test;}
+if ($^O eq 'amigaos' or $Is_MSWin32) {print "ok 35\n"; goto tty_test;}
$cnt = $uid = 0;
@@ -147,12 +155,18 @@ else
tty_test:
-unless (open(tty,"/dev/tty")) {
- print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
+if ($Is_MSWin32) {
+ print "ok 36\n";
+ print "ok 37\n";
+}
+else {
+ unless (open(tty,"/dev/tty")) {
+ print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
+ }
+ if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
+ if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
+ close(tty);
}
-if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
-if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
-close(tty);
if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
open(null,"/dev/null");
if (! -t null || -e '/xenix' || -e '/MachTen')
diff --git a/t/op/sysio.t b/t/op/sysio.t
index 0f546b270f..ee274c1692 100755
--- a/t/op/sysio.t
+++ b/t/op/sysio.t
@@ -6,7 +6,7 @@ chdir('op') || die "sysio.t: cannot look for myself: $!";
open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
-$reopen = ($^O eq 'VMS' || $^O eq 'os2');
+$reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32');
$x = 'abc';
diff --git a/t/op/taint.t b/t/op/taint.t
index 56765fb71d..66e26d82c9 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -16,14 +16,18 @@ use strict;
use Config;
my $Is_VMS = $^O eq 'VMS';
-my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' : './perl';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
+ $Is_MSWin32 ? '.\perl' : './perl';
if ($Is_VMS) {
+ my ($olddcl) = $ENV{'DCL$PATH'} =~ /^(.*)$/;
+ my ($oldifs) = $ENV{IFS} =~ /^(.*)$/;
eval <<EndOfCleanup;
END {
\$ENV{PATH} = '';
warn "# Note: logical name 'PATH' may have been deleted\n";
- \$ENV{IFS} = "$ENV{IFS}";
- \$ENV{'DCL\$PATH'} = "$ENV{'DCL$PATH'}";
+ \$ENV{IFS} = \$oldifs;
+ \$ENV{'DCL\$PATH'} = \$olddcl;
}
EndOfCleanup
}