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

13 files changed, 74 insertions, 29 deletions

diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index 8019df7187..df54f15d36 100644
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -105,6 +105,9 @@ $CheckModTime = 1;
 $IndexFile = "autosplit.ix";	# file also serves as timestamp
 $maxflen = 255;
 $maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
+if (defined (&Dos::UseLFN)) {
+     $maxflen = Dos::UseLFN() ? 255 : 11;
+}
 $Is_VMS = ($^O eq 'VMS');
 
 
@@ -199,7 +202,7 @@ sub autosplit_file{
 
     die "Package $package ($modpname.pm) does not match filename $filename"
 	    unless ($filename =~ m/\Q$modpname.pm\E$/ or
-		    ($^O eq "msdos") or ($^O eq 'MSWin32') or
+		    ($^O eq 'dos') or ($^O eq 'MSWin32') or
 	            $Is_VMS && $filename =~ m/$modpname.pm/i);
 
     my($al_idx_file) = "$autodir/$modpname/$IndexFile";
@@ -247,6 +250,8 @@ sub autosplit_file{
     #
     # For now both of these produce warnings.
 
+    my $Is83 = $maxflen==11;  # plain, case INSENSITIVE dos filenames
+
     open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
     my(@subnames, %proto);
     my @cache = ();
@@ -269,11 +274,10 @@ sub autosplit_file{
 	    my($spath) = "$autodir/$modpname/$sname.al";
 	    unless(open(OUT, ">$lpath")){
 		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
-		push(@names, $sname);
-		print "  writing $spath (with truncated name)\n"
-			if ($Verbose>=1);
+		push(@names, $Is83 ? lc $sname : $sname);
+		print "  writing $spath (with truncated name)\n" if ($Verbose>=1);
 	    }else{
-		push(@names, $lname);
+		push(@names, $Is83 ? lc substr ($lname,0,8) : $lname);
 		print "  writing $lpath\n" if ($Verbose>=2);
 	    }
 	    print OUT "# NOTE: Derived from $filename.  ",
@@ -310,6 +314,7 @@ sub autosplit_file{
 	    next unless /\.al$/;
 	    my($subname) = m/(.*)\.al$/;
 	    next if $names{substr($subname,0,$maxflen-3)};
+            next if ($Is83 && $names{lc substr($subname,0,8)});
 	    my($file) = "$autodir/$modpname/$_";
 	    print "  deleting $file\n" if ($Verbose>=2);
 	    my($deleted,$thistime);  # catch all versions on VMS
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 3bd0085c73..6952411ca2 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -199,7 +199,7 @@ sub fastcwd {
 my $chdir_init = 0;
 
 sub chdir_init {
-    if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') {
+    if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos') {
 	my($dd,$di) = stat('.');
 	my($pd,$pi) = stat($ENV{'PWD'});
 	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
@@ -349,10 +349,14 @@ sub _win32_cwd {
 
 *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
 
-sub _msdos_cwd {
-    $ENV{'PWD'} = `command /c cd`;
-    chop $ENV{'PWD'};
-    $ENV{'PWD'} =~ s:\\:/:g ;
+sub _dos_cwd {
+    if (!defined &Dos::GetCwd) {
+        $ENV{'PWD'} = `command /c cd`;
+        chop $ENV{'PWD'};
+        $ENV{'PWD'} =~ s:\\:/:g ;
+    } else {
+        $ENV{'PWD'} = Dos::GetCwd();
+    }
     return $ENV{'PWD'};
 }
 
@@ -383,11 +387,11 @@ sub _msdos_cwd {
         *fastcwd	= \&cwd;
         *abs_path	= \&fast_abs_path;
     }
-    elsif ($^O eq 'msdos') {
-        *cwd		= \&_msdos_cwd;
-        *getcwd		= \&_msdos_cwd;
-        *fastgetcwd	= \&_msdos_cwd;
-        *fastcwd	= \&_msdos_cwd;
+    elsif ($^O eq 'dos') {
+        *cwd		= \&_dos_cwd;
+        *getcwd		= \&_dos_cwd;
+        *fastgetcwd	= \&_dos_cwd;
+        *fastcwd	= \&_dos_cwd;
         *abs_path	= \&fast_abs_path;
     }
 }
diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
index 4400858e89..0803a999ff 100644
--- a/lib/ExtUtils/Install.pm
+++ b/lib/ExtUtils/Install.pm
@@ -11,7 +11,7 @@ use vars qw(@ISA @EXPORT $VERSION);
 @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
 $Is_VMS = $^O eq 'VMS';
 
-my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
+my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
 my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
 my $Inc_uninstall_warn_handler;
 
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index 4f7a9e8137..6703245562 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -5,7 +5,7 @@ use Config;
 use File::Basename qw(basename dirname fileparse);
 use DirHandle;
 use strict;
-use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32
+use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos
 	    $Verbose %pm %static $Xsubpp_Version);
 
 $VERSION = substr q$Revision: 1.118 $, 10;
@@ -17,6 +17,7 @@ Exporter::import('ExtUtils::MakeMaker',
 $Is_OS2 = $^O eq 'os2';
 $Is_Mac = $^O eq 'MacOS';
 $Is_Win32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
 
 if ($Is_VMS = $^O eq 'VMS') {
     require VMS::Filespec;
@@ -266,7 +267,7 @@ sub c_o {
     push @m, '
 .C$(OBJ_EXT):
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
-' if $^O ne 'os2' and $^O ne 'MSWin32';		# Case-specific
+' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific
     push @m, '
 .cpp$(OBJ_EXT):
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
@@ -1049,7 +1050,12 @@ Takes as argument a path and returns true, if it is an absolute path.
 
 sub file_name_is_absolute {
     my($self,$file) = @_;
-    $file =~ m:^/: ;
+    if ($Is_Dos){
+        $file =~ m{^([a-z]:)?[\\/]}i ;
+    }
+    else {
+        $file =~ m:^/: ;
+    }
 }
 
 =item find_perl
@@ -2298,6 +2304,9 @@ $tmp/perlmain.c: $makefilename}, q{
 		-e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
 
 };
+    push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
+} if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
+
 
     push @m, q{
 doc_inst_perl:
@@ -2575,7 +2584,7 @@ Takes no argument, returns the environment variable PATH as an array.
 
 sub path {
     my($self) = @_;
-    my $path_sep = $Is_OS2 ? ";" : ":";
+    my $path_sep = ($Is_OS2 || $Is_Dos) ? ";" : ":";
     my $path = $ENV{PATH};
     $path =~ s:\\:/:g if $Is_OS2;
     my @path = split $path_sep, $path;
diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm
index 0959a2fd73..8437346c91 100644
--- a/lib/ExtUtils/Manifest.pm
+++ b/lib/ExtUtils/Manifest.pm
@@ -87,10 +87,16 @@ sub _manicheck {
     my $read = maniread();
     my $found = manifind();
     my $file;
+    my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
     my(@missfile,@missentry);
     if ($arg & 1){
 	foreach $file (sort keys %$read){
 	    warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+            if ($dosnames){
+                $file = lc $file;
+                $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
+                $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
+            }
 	    unless ( exists $found->{$file} ) {
 		warn "No such file: $file\n" unless $Quiet;
 		push @missfile, $file;
diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index e4863f8911..5c6299e596 100644
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -141,7 +141,7 @@ sub fileparse_set_fstype {
   my @old = ($Fileparse_fstype, $Fileparse_igncase);
   if (@_) {
     $Fileparse_fstype = $_[0];
-    $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32)/i);
+    $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
   }
   wantarray ? @old : $old[0];
 }
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 033cfe5e9d..70629d4ce0 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -274,7 +274,7 @@ if ($^O =~ m:^mswin32:i) {
 }
 
 $dont_use_nlink = 1
-    if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos';
+    if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos';
 
 1;
 
diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 43856dfe7b..492f150b5a 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -111,7 +111,7 @@ my $Is_VMS = $^O eq 'VMS';
 
 # These OSes complain if you want to remove a file that you have no
 # write permission to:
-my $force_writeable = ($^O eq 'os2' || $^O eq 'msdos' || $^O eq 'MSWin32'
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32'
 		       || $^O eq 'amigaos');
 
 sub mkpath {
diff --git a/lib/FindBin.pm b/lib/FindBin.pm
index 918775cda7..881caa7559 100644
--- a/lib/FindBin.pm
+++ b/lib/FindBin.pm
@@ -87,7 +87,7 @@ $VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
 sub is_abs_path
 {
  local $_ = shift if (@_);
- if ($^O eq 'MSWin32')
+ if ($^O eq 'MSWin32' || $^O eq 'dos')
   {
    return m#^[a-z]:[\\/]#i;
   }
diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm
index ffeb0b2136..d6add626a6 100644
--- a/lib/Pod/Html.pm
+++ b/lib/Pod/Html.pm
@@ -199,6 +199,8 @@ my %pages = ();			# associative array used to find the location
 my %sections = ();		# sections within this page
 my %items = ();			# associative array used to find the location
 				#   of =item directives referenced by C<> links
+my $Is83;                       # is dos with short filenames (8.3)
+
 sub init_globals {
 $dircache = "pod2html-dircache";
 $itemcache = "pod2html-itemcache";
@@ -244,7 +246,7 @@ $paragraph = '';			# which paragraph we're processing (used
 				#   of pages referenced by L<> links.
 #%items = ();			# associative array used to find the location
 				#   of =item directives referenced by C<> links
-
+$Is83=$^O eq 'dos';
 }
 
 sub pod2html {
@@ -254,6 +256,8 @@ sub pod2html {
 
     init_globals();
 
+    $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
+
     # cache of %pages and %items from last time we ran pod2html
 
     #undef $opt_help if defined $opt_help;
@@ -1063,6 +1067,8 @@ sub process_text {
 		  }{
 		    if (defined $pages{$2}) {	# is a link
 			qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
+		    } elsif (defined $pages{dosify($2)}) {	# is a link
+			qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
 		    } else {
 			"$1$2";
 		    }
@@ -1309,6 +1315,19 @@ sub pre_escape {
 }
 
 #
+# dosify - convert filenames to 8.3
+#
+sub dosify {
+    my($str) = @_;
+    if ($Is83) {
+        $str = lc $str;
+        $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
+        $str =~ s/(\w+)/substr ($1,0,8)/ge;
+    }
+    return $str;
+}
+
+#
 # process_L - convert a pod L<> directive to a corresponding HTML link.
 #  most of the links made are inferred rather than known about directly
 #  (i.e it's not known whether the =head\d section exists in the target file,
@@ -1320,7 +1339,7 @@ sub pre_escape {
 #
 sub process_L {
     my($str) = @_;
-    my($s1, $s2, $linktext, $page, $section, $link);	# work strings
+    my($s1, $s2, $linktext, $page, $page83, $section, $link);	# work strings
 
     $str =~ s/\n/ /g;			# undo word-wrapped tags
     $s1 = $str;
@@ -1346,6 +1365,8 @@ sub process_L {
 	}
     }
 
+    $page83=dosify($page);
+    $page=$page83 if (defined $pages{$page83});
     if ($page eq "") {
 	$link = "#" . htmlify(0,$section);
 	$linktext = $section;
diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm
index 2b6c6b6297..96fda96aed 100644
--- a/lib/Pod/Text.pm
+++ b/lib/Pod/Text.pm
@@ -79,7 +79,7 @@ if($termcap and !$setuptermcap) {
 $SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1))
        ||  $ENV{COLUMNS}
        || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
-       || ($^O ne 'MSWin32' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
+       || ($^O ne 'MSWin32' && $^O ne 'dos' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
        || 72;
 
 @_ = ("<&STDIN") unless @_;
diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm
index 5703405c9d..1e95ec33b6 100644
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -106,7 +106,7 @@ sub termcap_path { ## private
     # $TERMCAP, if it's a filespec
     push(@termcap_path, $ENV{TERMCAP})
 	if ((exists $ENV{TERMCAP}) &&
-	    (($^O eq 'os2' || $^O eq 'MSWin32')
+	    (($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos')
 	     ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/i
 	     : $ENV{TERMCAP} =~ /^\//));
     if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index df56723dee..ea072e0f3b 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -290,7 +290,7 @@ if ($notty) {
 
   if (-e "/dev/tty") {
     $console = "/dev/tty";
-  } elsif (-e "con" or $^O eq 'MSWin32') {
+  } elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
     $console = "con";
   } else {
     $console = "sys\$command";