diff options
Diffstat (limited to 't/op')
-rwxr-xr-x | t/op/closure.t | 8 | ||||
-rwxr-xr-x | t/op/exec.t | 7 | ||||
-rwxr-xr-x | t/op/glob.t | 7 | ||||
-rwxr-xr-x | t/op/goto.t | 3 | ||||
-rwxr-xr-x | t/op/magic.t | 73 | ||||
-rwxr-xr-x | t/op/misc.t | 13 | ||||
-rwxr-xr-x | t/op/rand.t | 10 | ||||
-rwxr-xr-x | t/op/split.t | 3 | ||||
-rwxr-xr-x | t/op/stat.t | 40 | ||||
-rwxr-xr-x | t/op/sysio.t | 2 | ||||
-rwxr-xr-x | t/op/taint.t | 10 |
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 } |