Major changes to the DOS/djgpp port (including threading):

	Subject: Re: dos-djgpp port not in perl 5.004_54

p4raw-id: //depot/perl@373

12 files changed, 56 insertions, 37 deletions

diff --git a/t/io/fs.t b/t/io/fs.t
index ca82689c6f..eae0158103 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -9,6 +9,8 @@ BEGIN {
 
 use Config;
 
+$Is_Dos=$^O eq 'dos';
+
 # avoid win32 (for now)
 do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32';
 
@@ -30,35 +32,35 @@ close(fh);
 open(fh,'>a') || die "Can't create a";
 close(fh);
 
-if (eval {link('a','b')}) {print "ok 2\n";} else {print "not ok 2\n";}
+if (eval {link('a','b')} || $Is_Dos) {print "ok 2\n";} else {print "not ok 2\n";}
 
-if (eval {link('b','c')}) {print "ok 3\n";} else {print "not ok 3\n";}
+if (eval {link('b','c')} || $Is_Dos) {print "ok 3\n";} else {print "not ok 3\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
 
-if ($Config{dont_use_nlink} || $nlink == 3)
+if ($Config{dont_use_nlink} || $nlink == 3 || $Is_Dos)
     {print "ok 4\n";} else {print "not ok 4\n";}
 
-if (($mode & 0777) == 0666 || $^O eq 'amigaos')
+if (($mode & 0777) == 0666 || $^O eq 'amigaos' || $Is_Dos)
     {print "ok 5\n";} else {print "not ok 5\n";}
 
 if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
+if (($mode & 0777) == 0777 || $Is_Dos) {print "ok 7\n";} else {print "not ok 7\n";}
 
-if ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
+if ((chmod 0700,'c','x') == 2 || $Is_Dos) {print "ok 8\n";} else {print "not ok 8\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
+if (($mode & 0777) == 0700 || $Is_Dos) {print "ok 9\n";} else {print "not ok 9\n";}
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('x');
-if (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
+if (($mode & 0777) == 0700 || $Is_Dos) {print "ok 10\n";} else {print "not ok 10\n";}
 
-if ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
+if ((unlink 'b','x') == 2 || $Is_Dos) {print "ok 11\n";} else {print "not ok 11\n";}
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('b');
 if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
@@ -76,7 +78,7 @@ if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
     $blksize,$blocks) = stat('b');
 if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
 if (($atime == 500000000 && $mtime == 500000001)
-	|| $wd =~ m#/afs/# || $^O eq 'amigaos')
+	|| $wd =~ m#/afs/# || $^O eq 'amigaos' || $Is_Dos)
     {print "ok 18\n";}
 else
     {print "not ok 18 $atime $mtime\n";}
@@ -120,8 +122,14 @@ else {
   { select FH; $| = 1; select STDOUT }
   print FH "helloworld\n";
   truncate FH, 5;
+  if ($Is_Dos) {
+      close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+  }
   if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"}
   truncate FH, 0;
+  if ($Is_Dos) {
+      close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+  }
   if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
   close FH;
 }
diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index cadbfd5658..854f146337 100755
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -22,7 +22,7 @@ $Dfile = "Op.dbmx.pag";
 if (! -e $Dfile) {
 	($Dfile) = <Op.dbmx*>;
 }
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
 }
 else {
diff --git a/t/lib/filehand.t b/t/lib/filehand.t
index cedc2ebcb8..08cae71872 100755
--- a/t/lib/filehand.t
+++ b/t/lib/filehand.t
@@ -64,6 +64,12 @@ autoflush STDOUT 1;
 print "not " unless ($|);
 print "ok 10\n";
 
+if ($^O eq 'dos')
+{
+    printf("ok %d\n",11);
+    exit(0);
+}
+
 ($rd,$wr) = FileHandle::pipe;
 
 if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32') {
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index ebc9f56bc0..fea0cd7fb7 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -24,7 +24,7 @@ $Dfile = "Op.dbmx.pag";
 if (! -e $Dfile) {
 	($Dfile) = <Op.dbmx*>;
 }
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
 }
 else {
diff --git a/t/lib/io_sel.t b/t/lib/io_sel.t
index b9c1097404..3dc651bbc2 100755
--- a/t/lib/io_sel.t
+++ b/t/lib/io_sel.t
@@ -49,7 +49,7 @@ $sel->remove([\*STDOUT, 5]);
 print "not " unless $sel->count == 0 && !defined($sel->bits);
 print "ok 9\n";
 
-if ($^O eq 'MSWin32') {  # 4-arg select is only valid on sockets
+if ($^O eq 'MSWin32' || $^O eq 'dos') {  # 4-arg select is only valid on sockets
     print "# skipping tests 10..15\n";
     for (10 .. 15) { print "ok $_\n" }
     $sel->add(\*STDOUT);  # update
diff --git a/t/lib/io_tell.t b/t/lib/io_tell.t
index d8ebae24fd..2009d610db 100755
--- a/t/lib/io_tell.t
+++ b/t/lib/io_tell.t
@@ -27,7 +27,7 @@ print "1..13\n";
 use IO::File;
 
 $tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
-binmode $tst if $^O eq 'MSWin32';
+binmode $tst if ($^O eq 'MSWin32' or $^O eq 'dos');
 if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
 
 $firstline = <$tst>;
diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index ad25011d76..90dbb841e6 100755
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -27,7 +27,7 @@ $Dfile = "Op.dbmx.pag";
 if (! -e $Dfile) {
 	($Dfile) = <Op.dbmx*>;
 }
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
 }
 else {
diff --git a/t/lib/thread.t b/t/lib/thread.t
index 798adc12be..5ac9e5bf71 100755
--- a/t/lib/thread.t
+++ b/t/lib/thread.t
@@ -1,4 +1,4 @@
-#!perl
+#!./perl
 
 BEGIN {
     chdir 't' if -d 't';
diff --git a/t/op/magic.t b/t/op/magic.t
index e48b71cd68..80361ba0b7 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -21,13 +21,14 @@ sub ok {
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_VMS     = $^O eq 'VMS';
+$Is_Dos   = $^O eq 'dos';
 $PERL = ($Is_MSWin32 ? '.\perl' : './perl');
 
 print "1..30\n";
 
-eval '$ENV{"foo"} = "hi there";';	# check that ENV is inited inside eval
-if ($Is_MSWin32) { ok 1, `cmd /x /c set foo` eq "foo=hi there\n"; }
-else             { ok 1, `echo \$foo` eq "hi there\n"; }
+eval '$ENV{"FOO"} = "hi there";';	# check that ENV is inited inside eval
+if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; }
+else             { ok 1, `echo \$FOO` eq "hi there\n"; }
 
 unlink 'ajslkdfpqjsjfk';
 $! = 0;
@@ -35,7 +36,7 @@ open(FOO,'ajslkdfpqjsjfk');
 ok 2, $!, $!;
 close FOO; # just mention it, squelch used-only-once
 
-if ($Is_MSWin32) {
+if ($Is_MSWin32 || $Is_Dos) {
     ok 3,1;
     ok 4,1;
 }
@@ -148,10 +149,12 @@ EOF
     ok 21, close(SCRIPT), $!;
     ok 22, chmod(0755, $script), $!;
     $_ = `$script`;
+    s/.exe//i if $Is_Dos;
     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
     s{is perl}{is $perl}; # for systems where $^X is only a basename
     ok 23, ($Is_MSWin32 ? uc($_) eq uc($s2) : $_ eq $s2), ":$_:!=:$s2:";
     $_ = `$perl $script`;
+    s/.exe//i if $Is_Dos;
     ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
     ok 25, unlink($script), $!;
 }
@@ -161,7 +164,7 @@ ok 26, $] >= 5.00319, $];
 ok 27, $^O;
 ok 28, $^T > 850000000, $^T;
 
-if ($Is_VMS) {
+if ($Is_VMS || $Is_Dos) {
 	ok 29, 1;
 	ok 30, 1;
 }
diff --git a/t/op/stat.t b/t/op/stat.t
index 97f8192885..9d4b3a6787 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -12,15 +12,16 @@ use Config;
 print "1..56\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
 chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
 
-$DEV = `ls -l /dev` unless $Is_MSWin32;
+$DEV = `ls -l /dev` unless ($Is_MSWin32 || $Is_Dos);
 
 unlink "Op.stat.tmp";
 open(FOO, ">Op.stat.tmp");
 
 # hack to make Apollo update link count:
-$junk = `ls Op.stat.tmp` unless $Is_MSWin32;
+$junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat(FOO);
@@ -33,7 +34,7 @@ close(FOO);
 
 sleep 2;
 
-if ($Is_MSWin32) { unlink "Op.stat.tmp2" }
+if ($Is_MSWin32 || $Is_Dos) { unlink "Op.stat.tmp2" }
 else {
     `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
 }
@@ -41,10 +42,10 @@ else {
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('Op.stat.tmp');
 
-if ($Is_MSWin32 || $Config{dont_use_nlink} || $nlink == 2)
+if ($Is_MSWin32 || $Is_Dos || $Config{dont_use_nlink} || $nlink == 2)
     {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
 
-if ($Is_MSWin32 || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') {
+if ($Is_MSWin32 || $Is_Dos || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') {
     print "ok 4\n";
 }
 else {
@@ -70,7 +71,7 @@ $olduid = $>;		# can't test -r if uid == 0
 $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
 chmod 0,'Op.stat.tmp';
 eval '$> = 1;';		# so switch uid (may not be implemented)
-if (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
+if (!$> || $Is_Dos || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
 if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
 eval '$> = $olduid;';		# switch uid back (may not be implemented)
 print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
@@ -85,7 +86,7 @@ foreach ((12,13,14,15,16,17)) {
 chmod 0700,'Op.stat.tmp';
 if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
 if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
-if ($Is_MSWin32 or -x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
+if ($Is_MSWin32 or $Is_Dos or -x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
 
 if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
 if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
@@ -93,7 +94,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 (!$Is_MSWin32 and `ls -l perl` =~ /^l.*->/) {
+if (!($Is_MSWin32 || $Is_Dos) and `ls -l perl` =~ /^l.*->/) {
     if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
 }
 else {
@@ -106,7 +107,7 @@ if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
 unlink 'Op.stat.tmp', 'Op.stat.tmp2';
 if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
 
-if ($Is_MSWin32)
+if ($Is_MSWin32 || $Is_Dos)
     {print "ok 29\n";}
 elsif ($DEV !~ /\nc.* (\S+)\n/)
     {print "ok 29\n";}
@@ -116,7 +117,7 @@ else
     {print "not ok 29\n";}
 if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
 
-if ($Is_MSWin32)
+if ($Is_MSWin32 || $Is_Dos)
     {print "ok 31\n";}
 elsif ($DEV !~ /\ns.* (\S+)\n/)
     {print "ok 31\n";}
@@ -126,7 +127,7 @@ else
     {print "not ok 31\n";}
 if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
 
-if ($Is_MSWin32)
+if ($Is_MSWin32 || $Is_Dos)
     {print "ok 33\n";}
 elsif ($DEV !~ /\nb.* (\S+)\n/)
     {print "ok 33\n";}
@@ -136,7 +137,7 @@ else
     {print "not ok 33\n";}
 if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
 
-if ($^O eq 'amigaos' or $Is_MSWin32) {print "ok 35\n"; goto tty_test;}
+if ($^O eq 'amigaos' or $Is_MSWin32 || $Is_Dos) {print "ok 35\n"; goto tty_test;}
 
 $cnt = $uid = 0;
 
diff --git a/t/op/sysio.t b/t/op/sysio.t
index 0af333db84..826cf383ae 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' || $^O eq 'MSWin32');
+$reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos');
 
 $x = 'abc';
 
diff --git a/t/op/taint.t b/t/op/taint.t
index 22bb574a09..e18f123e9d 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,6 +17,7 @@ use Config;
 
 my $Is_VMS = $^O eq 'VMS';
 my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_Dos = $^O eq 'dos';
 my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
                   $Is_MSWin32 ? '.\perl' : './perl';
 my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
@@ -96,7 +97,7 @@ print "1..140\n";
 
     test 1, eval { `$echo 1` } eq "1\n";
 
-    if ($Is_MSWin32 || $Is_VMS) {
+    if ($Is_MSWin32 || $Is_VMS || $Is_Dos) {
 	print "# Environment tainting tests skipped\n";
 	for (2..5) { print "ok $_\n" }
     }
@@ -120,7 +121,7 @@ print "1..140\n";
     }
 
     my $tmp;
-    unless ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32) {
+    unless ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) {
 	$tmp = (grep { defined and -d and (stat _)[2] & 2 }
 		     qw(/tmp /var/tmp /usr/tmp /sys$scratch),
 		     @ENV{qw(TMP TEMP)})[0]
@@ -340,7 +341,7 @@ else {
 
     test 65, eval { open FOO, $foo } eq '', 'open for read';
     test 66, $@ eq '', $@;		# NB: This should be allowed
-    test 67, $! == 2;			# File not found
+    test 67, $! == ($Config{"archname"} !~ "djgpp" ? 2 : 22); # File not found
 
     test 68, eval { open FOO, "> $foo" } eq '', 'open for write';
     test 69, $@ =~ /^Insecure dependency/, $@;