Major changes to the DOS/djgpp port (including threading):
authorMolnar Laszlo <molnarl@cdata.tvnet.hu>
Fri, 21 Nov 1997 10:58:26 +0000 (11:58 +0100)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Wed, 17 Dec 1997 14:10:50 +0000 (14:10 +0000)
Subject: Re: dos-djgpp port not in perl 5.004_54

p4raw-id: //depot/perl@373

45 files changed:
Configure
MANIFEST
Makefile.SH
README.dos [new file with mode: 0644]
djgpp/config.over [new file with mode: 0644]
djgpp/configure.bat [new file with mode: 0644]
djgpp/djgpp.c [new file with mode: 0644]
djgpp/djgppsed.sh [new file with mode: 0644]
djgpp/fixpmain [new file with mode: 0644]
doio.c
dosish.h
ext/POSIX/POSIX.xs
hints/dos_djgpp.sh [new file with mode: 0644]
installhtml
installperl
lib/AutoSplit.pm
lib/Cwd.pm
lib/ExtUtils/Install.pm
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/Manifest.pm
lib/File/Basename.pm
lib/File/Find.pm
lib/File/Path.pm
lib/FindBin.pm
lib/Pod/Html.pm
lib/Pod/Text.pm
lib/Term/Cap.pm
lib/perl5db.pl
makedepend.SH
mg.c
perl.c
pod/pod2man.PL
pp_hot.c
t/io/fs.t
t/lib/anydbm.t
t/lib/filehand.t
t/lib/gdbm.t
t/lib/io_sel.t
t/lib/io_tell.t
t/lib/sdbm.t
t/lib/thread.t
t/op/magic.t
t/op/stat.t
t/op/sysio.t
t/op/taint.t

index daf4d0a..e73a241 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -63,6 +63,9 @@ if test -d c:/. -a -n "$OS2_SHELL"; then
        PATH=`cmd /c "echo %PATH%" | tr '\\\\' / `
        OS2_SHELL=`cmd /c "echo %OS2_SHELL%" | tr '\\\\' / | tr '[A-Z]' '[a-z]'`
 fi
+if test -d c:/. -a -n "$DJDIR"; then
+        p_=\;
+fi
 
 : Proper PATH setting
 paths='/bin /usr/bin /usr/local/bin /usr/ucb /usr/local /usr/lbin'
@@ -1900,6 +1903,10 @@ EOM
                        set X $myuname
                        osname=os2
                        osvers="$5"
+                       if test -n "$DJDIR"; then
+                               osname=dos
+                               osvers=djgpp
+                       fi
                fi
        fi
        
@@ -10058,35 +10065,35 @@ cd ../UU
 avail_ext=''
 for xxx in $known_extensions ; do
     case "$xxx" in
-    DB_File) case "$i_db" in 
+    DB_File|db_file) case "$i_db" in
            $define) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    GDBM_File) case "$i_gdbm" in 
+    GDBM_File|gdbm_fil) case "$i_gdbm" in 
            $define) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    NDBM_File) case "$i_ndbm" in 
+    NDBM_File|ndbm_fil) case "$i_ndbm" in
            $define) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    ODBM_File) case "${i_dbm}${i_rpcsvcdbm}" in 
+    ODBM_File|odbm_fil) case "${i_dbm}${i_rpcsvcdbm}" in
            *"${define}"*) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    POSIX) case "$useposix" in 
+    POSIX|posix) case "$useposix" in
            true|define|y) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    Opcode) case "$useopcode" in 
+    Opcode|opcode) case "$useopcode" in
            true|define|y) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    Socket) case "$d_socket" in 
+    Socket|socket) case "$d_socket" in 
            $define) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
-    Thread) case "$usethreads" in 
+    Thread|thread) case "$usethreads" in 
            $define) avail_ext="$avail_ext $xxx" ;;
            esac
            ;;
index 7585e5b..e25bf60 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -19,6 +19,7 @@ Porting/pumpkin.pod   Guidelines and hints for Perl maintainers
 README                 The Instructions
 README.amiga           Notes about AmigaOS port
 README.cygwin32                Notes about Cygwin32 port
+README.dos             Notes about dos/djgpp port
 README.os2             Notes about OS/2 port
 README.plan9           Notes about Plan9 port
 README.qnx             Notes about QNX port
@@ -43,6 +44,11 @@ cygwin32/ld2         Cygwin32 port
 cygwin32/perlgcc       Cygwin32 port
 cygwin32/perlld                Cygwin32 port
 deb.c                  Debugging routines
+djgpp/config.over       DOS/DJGPP port
+djgpp/configure.bat     DOS/DJGPP port
+djgpp/djgpp.c          DOS/DJGPP port
+djgpp/djgppsed.sh      DOS/DJGPP port
+djgpp/fixpmain         DOS/DJGPP port
 doio.c                 I/O operations
 doop.c                 Support code for various operations
 dosish.h               Some defines for MS/DOSish machines
@@ -273,6 +279,7 @@ hints/cygwin32.sh   Hints for named architecture
 hints/dcosx.sh         Hints for named architecture
 hints/dec_osf.sh       Hints for named architecture
 hints/dgux.sh          Hints for named architecture
+hints/dos_djgpp.sh     Hints for named architecture
 hints/dynix.sh         Hints for named architecture
 hints/dynixptx.sh      Hints for named architecture
 hints/epix.sh          Hints for named architecture
index 2e90be0..d334525 100644 (file)
@@ -354,7 +354,7 @@ lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm
        ./miniperl minimod.pl > tmp && mv tmp $@
 
 $(plextract):  miniperl lib/Config.pm
-       ./miniperl -Ilib $@.PL
+       `echo ./miniperl -Ilib $@.PL`
 
 install: all install.perl install.man
 
diff --git a/README.dos b/README.dos
new file mode 100644 (file)
index 0000000..3d1b33c
--- /dev/null
@@ -0,0 +1,164 @@
+This is a DOS/DJGPP port of Perl 5.004_5x
+
+1. Installation
+   ------------
+
+   - Unzip the binary package perl54b.zip preserving the directory
+     structure (-d switch to PKUNZIP) from the top DJGPP directory.
+     If you want to use perl with long file names (win0.95), then use a LFN
+     aware unzip and add
+
+              set LFN=y
+
+     to your autoexec.bat or DJGPP.ENV.
+
+   - Edit lib/perl5/Config.pm, and replace every 'c:/djgpp' with your
+     DJGPP root directory. This can be done with perl too:
+   
+              perl -i~ -pe "s!c:/djgpp!x:/djroot!i;" lib/perl5/Config.pm
+                                       ^^^^^^^^^
+                        Substitute this with your DJGPP root directory!
+
+   - This version of perl searches its library files in '../lib/perl5/',
+     which is relative to the path of perl.exe. If you don't like this,
+     you can use the PERL5LIB environment variable to tell perl where 
+     the library is. E.g:
+     
+              set PERL5LIB=c:/perl/lib
+              
+     Warning: if you set PERL5LIB and use tainting checks (-T command line 
+     option), perl ignores PERL5LIB, so you must use the -I command line
+     switch or the "use lib '...'"  construct. Or you can patch perl.exe :)
+
+   - Perl works best with a unixy shell, so you may want to download and
+     install bash (bshXXXXb.zip from the usual DJGPP sites). After installing
+     it make the 'SHELL' environment variable point to your bash.exe.
+     Finally create a `link' to your bash.exe in your %DJDIR%/bin directory:
+
+              ln -s bash.exe sh.exe
+     or
+              stubify -g sh.exe
+              stubedit sh.exe runfile=bash
+
+   - The documentation is in lib/perl5/pod. You can read the .pod files
+     with any editor, or you can use the `perldoc' utility. For more info:
+
+              perl -S perldoc -h
+
+     It tries to use less.exe or more.com, but you can set your pager with:
+     
+              SET PAGER=path_of_your_favourite_pager
+
+2. Building Perl
+   -------------
+
+   - In addition to the standard DJGPP tools, you will need sed, gawk, grep,
+     sh-utils, textutils, fileutils, bash, diffutils, make and findutils. :-)
+     You can find them on the usual DJGPP sites. If you want to build perl
+     under win0.95, then you MUST use fileutils 3.16+ (3.13 doesn't work).
+
+   - Unzip the source package perl54s.zip preserving the directory
+     structure (-d switch to PKUNZIP) from the top DJGPP directory.
+     Under plain DOS, use the -o switch too when unzipping.
+     This creates the directory gnu/perl5004.
+
+   - Create a symlink or copy your bash.exe to sh.exe in your DJGPP/bin
+     directory.
+
+              ln -s bash.exe sh.exe
+
+     And make the 'SHELL' environment variable point to this sh.exe:
+
+              set SHELL=c:/djgpp/bin/sh.exe (use full path name!)
+
+     You can do this in djgpp.env too. Add this line BEFORE any section
+     definition:
+
+              +SHELL=%DJDIR%/bin/sh.exe
+
+   - If you have split.exe and gsplit.exe in your path, then rename split.exe
+     to djsplit.exe, and gsplit.exe to split.exe.
+
+   - Copy or link gecho.exe to echo.exe if you don't have echo.exe.
+
+   - Copy or link gawk.exe to awk.exe if you don't have awk.exe.
+
+   - Chdir to the gnu/perl5004/djgpp directory and type the following
+     command:
+
+              configure.bat
+
+     This will do some preprocessing then run the Configure script.
+
+     The Configure script is interactive, but in most of the cases you
+     just need to press ENTER.
+
+     If the script says that your package is incomplete, and ask whether
+     to continue, just answer with Y (this can only happen if you don't use
+     long filenames).
+
+     When Configure asks about the extensions, I suggest IO and Fcntl,
+     and if you want database handling then SDBM_File or GDBM_File
+     (you need to install gdbm for this one). If you want to use the 
+     POSIX extension (this is the default), make sure that the stack 
+     size of your cc1.exe is at least 512kbyte (you can check this 
+     with: stubedit cc1.exe).
+     
+        You can use the Configure script in non-interactive mode too. 
+        When I've built my perl.exe, I used this:
+
+                 configure.bat -Uuseposix -dEs
+
+        then edited config.sh (set hostname & domainname), then
+
+                 sh Configure -S
+
+        You can find more info about Configure's command line switches in
+        the `INSTALL' file.
+
+   - When the script ends, and you want to change some values in the
+     generated config.sh file, then run
+
+              sh Configure -S
+
+     after you made your modifications.
+
+     IMPORTANT: if you use this -S switch, be sure to delete the CONFIG
+     environment variable before running the script:
+
+              set CONFIG=
+
+   - Now you can compile Perl. Type:
+
+              make
+
+   - Run the tests:
+
+              make test
+
+     You should see "All tests successful" if you configured a database
+     manager, and 1 failed test script if not (lib/anydbm.t). If you
+     configured POSIX you will see 4 failed subtests in lib/posix.t.
+
+   - If you want the documentation in HTML format, then read INSTALL in
+     the main perl5004 source directory.
+
+     WARNING: if you want to use absolute path names with `installhtml',
+     use something like this:
+
+             --htmldir=f:/html
+             --htmlroot='/f|/html'     # "|" instead of ":" !!!
+
+     or NETSCAPE does strange things.
+
+   - If you don't want to use the modules, then you are ready: copy perl.exe
+     into your bin directory.
+
+   - Else install the files with:
+
+              make install
+
+ Enjoy.
+
+                               Laszlo Molnar <molnarl@cdata.tvnet.hu>
+
diff --git a/djgpp/config.over b/djgpp/config.over
new file mode 100644 (file)
index 0000000..ed443d3
--- /dev/null
@@ -0,0 +1,16 @@
+ln='cp'
+pager='less'
+
+# This is because of the filename conversion under DOS
+repair()
+{
+    echo "$1" | tr '[a-z]' '[A-Z]' | sed -e 's/CNTL/cntl/'\
+         -e 's/_FIL/_File/g' -e 's/PCODE/pcode/' -e 's/OCKET/ocket/'\
+         -e 's/leE/le/g' -e 's/ATTRS/attrs/' -e 's/HREAD/hread/'
+}
+static_ext=$(repair "$static_ext")
+extensions=$(repair "$extensions")
+known_extensions=$(repair "$known_extensions")
+
+# I use Dos::UseLFN in AutoSplit.pm to override this under win0.95
+d_flexfnam='undef'
diff --git a/djgpp/configure.bat b/djgpp/configure.bat
new file mode 100644 (file)
index 0000000..64b46ec
--- /dev/null
@@ -0,0 +1,37 @@
+@echo off\r
+set CONFIG=\r
+set PATH_SEPARATOR=;\r
+set PATH_EXPAND=y\r
+sh -c 'if test $PATH_SEPARATOR = ";"; then exit 1; fi'\r
+if ERRORLEVEL 1 goto path_sep_ok\r
+echo Error:\a\r
+echo Make sure the environment variable PATH_SEPARATOR=; while building perl!\r
+echo Please check your DJGPP.ENV!\r
+goto end\r
+\r
+:path_sep_ok\r
+sh -c 'if test $PATH_EXPAND = "Y" -o $PATH_EXPAND = "y"; then exit 1; fi'\r
+if ERRORLEVEL 1 goto path_exp_ok\r
+echo Error:\a\r
+echo Make sure the environment variable PATH_EXPAND=Y while building perl!\r
+echo Please check your DJGPP.ENV!\r
+goto end\r
+\r
+:path_exp_ok\r
+sh -c '$SHELL -c "exit 128"'\r
+if ERRORLEVEL 128 goto shell_ok\r
+\r
+echo Error:\a\r
+echo The SHELL environment variable must be set to the full path of your sh.exe!\r
+goto end\r
+\r
+:shell_ok\r
+sh -c 'if test ! -d /tmp; then mkdir /tmp; fi'\r
+cp djgpp.c config.over ..\r
+cd ..\r
+echo Running sed...\r
+sh djgpp/djgppsed.sh\r
+\r
+echo Running Configure...\r
+sh Configure %1 %2 %3 %4 %5 %6 %7 %8 %9\r
+:end\r
diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c
new file mode 100644 (file)
index 0000000..578a1f9
--- /dev/null
@@ -0,0 +1,490 @@
+#include <libc/stubs.h>
+#include <io.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <libc/file.h>
+#include <process.h>
+#include <fcntl.h>
+#include <glob.h>
+#include <sys/fsext.h>
+#include <crt0.h>
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#if DJGPP==2 && DJGPP_MINOR<2
+
+/* XXX I should rewrite this stuff someday. ML */
+
+/* This is from popen.c */
+
+/* Copyright (C) 1997 DJ Delorie, see COPYING.DJ for details */
+/* Copyright (C) 1996 DJ Delorie, see COPYING.DJ for details */
+/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
+
+/* hold file pointer, descriptor, command, mode, temporary file name,
+   and the status of the command  */
+struct pipe_list {
+  FILE *fp;
+  int fd;
+  int exit_status;
+  char *command, mode[10], temp_name[L_tmpnam];
+  struct pipe_list *next;
+};
+
+/* static, global list pointer */
+static struct pipe_list *pl = NULL;
+
+FILE *
+popen (const char *cm, const char *md) /* program name, pipe mode */
+{
+  struct pipe_list *l1;
+
+  /* make new node */
+  if ((l1 = (struct pipe_list *) malloc (sizeof (struct pipe_list))) == NULL)
+    return NULL;
+
+  /* zero out elements to we'll get here */
+  l1->fp = NULL;
+  l1->next = pl;
+  pl = l1;
+
+  /* stick in elements we know already */
+  l1->exit_status = -1;
+  strcpy (l1->mode, md);
+  if (tmpnam (l1->temp_name) == NULL)
+    return NULL;
+
+  /* if can save the program name, build temp file */
+  if ((l1->command = malloc(strlen(cm)+1)))
+  {
+    strcpy(l1->command, cm);
+    /* if caller wants to read */
+    if (l1->mode[0] == 'r')
+    {
+      /* dup stdout */
+      if ((l1->fd = dup (fileno (stdout))) == EOF)
+       l1->fp = NULL;
+      else if (!(l1->fp = freopen (l1->temp_name, "wb", stdout)))
+       l1->fp = NULL;
+      else
+       /* exec cmd */
+      {
+        if ((l1->exit_status = system (cm)) == EOF)
+          l1->fp = NULL;
+      }
+      /* reopen real stdout */
+      if (dup2 (l1->fd, fileno (stdout)) == EOF)
+       l1->fp = NULL;
+      else
+       /* open file for reader */
+       l1->fp = fopen (l1->temp_name, l1->mode);
+      close(l1->fd);
+    }
+    else
+      /* if caller wants to write */
+      if (l1->mode[0] == 'w')
+        /* open temp file */
+        l1->fp = fopen (l1->temp_name, l1->mode);
+      else
+        /* unknown mode */
+        l1->fp = NULL;
+  }
+  return l1->fp;              /* return == NULL ? ERROR : OK */
+}
+
+int
+pclose (FILE *pp)
+{
+  struct pipe_list *l1, *l2;    /* list pointers */
+  int retval=0;                        /* function return value */
+
+  /* if pointer is first node */
+  if (pl->fp == pp)
+  {
+    /* save node and take it out the list */
+    l1 = pl;
+    pl = l1->next;
+  }
+  else
+    /* if more than one node in list */
+    if (pl->next)
+    {
+      /* find right node */
+      for (l2 = pl, l1 = pl->next; l1; l2 = l1, l1 = l2->next)
+        if (l1->fp == pp)
+          break;
+
+      /* take node out of list */
+      l2->next = l1->next;
+    }
+    else
+      return -1;
+
+  /* if FILE not in list - return error */
+  if (l1->fp == pp)
+  {
+    /* close the (hopefully) popen()ed file */
+    fclose (l1->fp);
+
+    /* if pipe was opened to write */
+    if (l1->mode[0] == 'w')
+    {
+      /* dup stdin */
+      if ((l1->fd = dup (fileno (stdin))) == EOF)
+       retval = -1;
+      else
+       /* open temp stdin */
+       if (!(l1->fp = freopen (l1->temp_name, "rb", stdin)))
+         retval = -1;
+       else
+         /* exec cmd */
+          if ((retval = system (l1->command)) != EOF)
+         {
+            /* reopen stdin */
+           if (dup2 (l1->fd, fileno (stdin)) == EOF)
+             retval = -1;
+         }
+      close(l1->fd);
+    }
+    else
+      /* if pipe was opened to read, return the exit status we saved */
+      if (l1->mode[0] == 'r')
+        retval = l1->exit_status;
+      else
+        /* invalid mode */
+        retval = -1;
+  }
+  remove (l1->temp_name);       /* remove temporary file */
+  free (l1->command);           /* dealloc memory */
+  free (l1);                    /* dealloc memory */
+
+  return retval;              /* retval==0 ? OK : ERROR */
+}
+
+#endif
+
+/**/
+
+#define EXECF_SPAWN 0
+#define EXECF_EXEC 1
+
+static int
+convretcode (int rc,char *prog,int fl)
+{
+    if (rc < 0 && dowarn)
+        warn ("Can't %s \"%s\": %s",fl ? "exec" : "spawn",prog,Strerror (errno));
+    if (rc > 0)
+        return rc <<= 8;
+    if (rc < 0)
+        return 255 << 8;
+    return 0;
+}
+
+int
+do_aspawn (SV *really,SV **mark,SV **sp)
+{
+    dTHR;
+    int  rc;
+    char **a,*tmps,**argv; 
+
+    if (sp<=mark)
+        return -1;
+    a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
+
+    while (++mark <= sp)
+        if (*mark)
+            *a++ = SvPVx(*mark, na);
+        else
+            *a++ = "";
+    *a = Nullch;
+
+    if (argv[0][0] != '/' && argv[0][0] != '\\'
+        && !(argv[0][0] && argv[0][1] == ':'
+        && (argv[0][2] == '/' || argv[0][2] != '\\'))
+     ) /* will swawnvp use PATH? */
+         TAINT_ENV();  /* testing IFS here is overkill, probably */
+
+    if (really && *(tmps = SvPV(really, na)))
+        rc=spawnvp (P_WAIT,tmps,argv);
+    else
+        rc=spawnvp (P_WAIT,argv[0],argv);
+
+    return convretcode (rc,argv[0],EXECF_SPAWN);
+}
+
+#define EXTRA "\x00\x00\x00\x00\x00\x00"
+
+int
+do_spawn2 (char *cmd,int execf)
+{
+    char **a,*s,*shell,*metachars;
+    int  rc,unixysh;
+
+    if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
+       shell="c:\\command.com" EXTRA;
+
+    unixysh=_is_unixy_shell (shell);
+    metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA;
+
+    while (*cmd && isSPACE(*cmd))
+       cmd++;
+
+    if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
+        cmd+=5;
+
+    /* save an extra exec if possible */
+    /* see if there are shell metacharacters in it */
+    if (strstr (cmd,"..."))
+        goto doshell;
+    if (unixysh)
+    {
+        if (*cmd=='.' && isSPACE (cmd[1]))
+            goto doshell;
+        if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
+            goto doshell;
+        for (s=cmd; *s && isALPHA (*s); s++) ; /* catch VAR=val gizmo */
+            if (*s=='=')
+                goto doshell;
+    }
+    for (s=cmd; *s; s++)
+       if (strchr (metachars,*s))
+       {
+           if (*s=='\n' && s[1]=='\0')
+           {
+               *s='\0';
+               break;
+           }
+doshell:
+           if (execf==EXECF_EXEC)
+                return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
+            return convretcode (system (cmd),cmd,execf);
+       }
+
+    New (1303,Argv,(s-cmd)/2+2,char*);
+    Cmd=savepvn (cmd,s-cmd);
+    a=Argv;
+    for (s=Cmd; *s;) {
+       while (*s && isSPACE (*s)) s++;
+       if (*s)
+           *(a++)=s;
+       while (*s && !isSPACE (*s)) s++;
+       if (*s)
+           *s++='\0';
+    }
+    *a=Nullch;
+    if (!Argv[0])
+        return -1;
+
+    if (execf==EXECF_EXEC)
+        rc=execvp (Argv[0],Argv);
+    else
+        rc=spawnvp (P_WAIT,Argv[0],Argv);
+    return convretcode (rc,Argv[0],execf);
+}
+
+int
+do_spawn (char *cmd)
+{
+    return do_spawn2 (cmd,EXECF_SPAWN);
+}
+
+bool
+do_exec (char *cmd)
+{
+    do_spawn2 (cmd,EXECF_EXEC);
+    return FALSE;
+}
+
+/**/
+
+struct globinfo
+{
+    int    fd;
+    char   *matches;
+    size_t size;
+};
+
+#define MAXOPENGLOBS 10
+
+static struct globinfo myglobs[MAXOPENGLOBS];
+
+static struct globinfo *
+searchfd (int fd)
+{
+    int ic;
+    for (ic=0; ic<MAXOPENGLOBS; ic++)
+        if (myglobs[ic].fd==fd)
+            return myglobs+ic;
+    return NULL;
+}
+
+static int
+glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
+{
+    unsigned ic;
+    struct globinfo *gi;
+    switch (n)
+    {
+        case __FSEXT_open:
+        {
+            char   *p1,*pattern,*name=va_arg (args,char*);
+            STRLEN len;
+            glob_t pglob;
+
+            if (strnNE (name,"/dev/dosglob/",13))
+                break;
+            if ((gi=searchfd (-1)) == NULL)
+                break;
+
+            pattern=alloca (strlen (name+=13)+1);
+            strcpy (pattern,name);
+            if (!_USE_LFN)
+                strlwr (pattern);
+            ic=pglob.gl_pathc=0;
+            pglob.gl_pathv=NULL;
+            while (pattern)
+            {
+                if ((p1=strchr (pattern,' '))!=NULL)
+                    *p1=0;
+                glob (pattern,ic,0,&pglob);
+                ic=GLOB_APPEND;
+                if ((pattern=p1)!=NULL)
+                    pattern++;
+            }
+            for (ic=len=0; ic<pglob.gl_pathc; ic++)
+                len+=1+strlen (pglob.gl_pathv[ic]);
+            if (len)
+            {
+                if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
+                    break;
+                for (ic=0; ic<pglob.gl_pathc; ic++)
+                {
+                    strcpy (p1,pglob.gl_pathv[ic]);
+                    p1+=strlen (p1)+1;
+                }
+            }
+            else
+            {
+                if ((gi->matches=strdup (name))==NULL)
+                    break;
+                gi->size=strlen (name)+1;
+            }
+            globfree (&pglob);
+            gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
+            return 1;
+        }
+        case __FSEXT_read:
+        {
+            int      fd=va_arg (args,int);
+            char   *buf=va_arg (args,char*);
+            size_t  siz=va_arg (args,size_t);
+
+            if ((gi=searchfd (fd))==NULL)
+                break;
+
+            ic=tell (fd);
+            if (siz+ic>=gi->size)
+                siz=gi->size-ic;
+            memcpy (buf,ic+gi->matches,siz);
+            lseek (fd,siz,1);
+            *rv=siz;
+            return 1;
+        }
+        case __FSEXT_close:
+        {
+            int fd=va_arg (args,int);
+
+            if ((gi=searchfd (fd))==NULL)
+                break;
+            free (gi->matches);
+            gi->fd=-1;
+            break;
+        }
+        default:
+            break;
+    }
+    return 0;
+}
+
+static
+XS(dos_GetCwd)
+{
+    dXSARGS;
+
+    if (items)
+        croak ("Usage: Dos::GetCwd()");
+    {
+        char tmp[PATH_MAX+2];
+        ST(0)=sv_newmortal ();
+        if (getcwd (tmp,PATH_MAX+1)!=NULL)
+            sv_setpv ((SV*)ST(0),tmp);
+    }
+    XSRETURN (1);
+}
+
+static
+XS(dos_UseLFN)
+{
+    dXSARGS;
+    XSRETURN_IV (_USE_LFN);
+}
+
+void
+init_os_extras()
+{
+    char *file = __FILE__;
+
+    dXSUB_SYS;
+    
+    newXS ("Dos::GetCwd",dos_GetCwd,file);
+    newXS ("Dos::UseLFN",dos_UseLFN,file);
+
+    /* install my File System Extension for globbing */
+    __FSEXT_add_open_handler (glob_handler);
+    memset (myglobs,-1,sizeof (myglobs));
+}
+
+static char *perlprefix;
+
+#define PERL5 "/perl5"
+
+char *djgpp_pathexp (const char *p)
+{
+    static char expp[PATH_MAX];
+    strcpy (expp,perlprefix);
+    switch (p[0])
+    {
+        case 'B':
+            strcat (expp,"/bin");
+            break;
+        case 'S':
+            strcat (expp,"/lib" PERL5 "/site");
+            break;
+        default:
+            strcat (expp,"/lib" PERL5);
+            break;
+    }
+    return expp;
+}
+
+void
+Perl_DJGPP_init (int *argcp,char ***argvp)
+{
+    char *p;
+
+    perlprefix=strdup (**argvp);
+    strlwr (perlprefix);
+    if ((p=strrchr (perlprefix,'/'))!=NULL)
+    {
+        *p=0;
+        if (strEQ (p-4,"/bin"))
+            p[-4]=0;
+    }
+    else
+        strcpy (perlprefix,"..");
+}
+
diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh
new file mode 100644 (file)
index 0000000..5acf0ce
--- /dev/null
@@ -0,0 +1,44 @@
+#! /bin/sh
+
+# Change some files to work under DOS
+# Most of this stuff does .xx -> _xx and aa.bb.ccc -> aa_bb.cc conversion
+
+SCONFIG='s=\.\(config\)=_\1=g'
+SLIST='s=\.\([a-z]\+list\)=_\1=g'
+SGREPTMP='s=\.\(greptmp\)=_\1=g'
+SECHOTMP='s=\.\(echotmp\)=_\1=g'
+SDDC='s=\.\($$\.c\)=_\1=g'
+SOUT='s=\([^a-z1-9?]\)\.\(out\)=\1_\2=g'
+SEXISTS='s=\.\(exists\)=_\1=g'
+SPOD2HTML='s=pod2html-=pod2html.=g'
+SCC='s=\.c\.c=.c_c=g'
+SFILEC="s=\(\$file\)\.c=\\1'_c'=g"
+SCOR='s=c\\\.c|=c\_c|=g'
+SHSED='s=\.\(hsed\)=_\1=g'
+SDEPTMP='s=\.\(deptmp\)=_\1=g'
+SCPP='s=\.\(cpp\.\)=_\1=g'
+SARGV='s=\.\(argv\.\)=_\1=g'
+SABC='s=\.\([abc][^a]\)=_\1=g'
+SDBMX='s=\.\(dbmx\)=_\1=g'
+SDBHASH='s=dbhash\.tmp=dbhash_tmp=g'
+SSTAT='s=\.\(stat\.\)=_\1=g'
+STMP2='s=tmp2=tm2=g'
+SPACKLIST='s=\.\(packlist\)=_\1=g'
+
+sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT Configure |tr -d '\r' >s; mv -f s Configure
+sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH
+sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/Install.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/Install.pm
+sed -e $SEXISTS -e $SPACKLIST lib/ExtUtils/MM_Unix.pm |tr -d '\r' >s; mv -f s lib/ExtUtils/MM_Unix.pm
+sed -e $SEXISTS installperl >s; mv -f s installperl
+sed -e $SPOD2HTML lib/Pod/Html.pm |tr -d '\r' >s; mv -f s lib/Pod/Html.pm
+sed -e $SCC -e $SLIST -e $SFILEC -e $SCOR -e $SDEPTMP -e $SHSED makedepend.SH |tr -d '\r' >s; mv -f s makedepend.SH
+sed -e $SCPP t/comp/cpp.aux |tr -d '\r' >s; mv -f s t/comp/cpp.aux
+sed -e $SARGV t/io/argv.t >s; mv -f s t/io/argv.t
+sed -e $SABC t/io/inplace.t >s; mv -f s t/io/inplace.t
+sed -e $SDBMX t/lib/anydbm.t >s; mv -f s t/lib/anydbm.t
+sed -e $SDBMX -e $SDBHASH t/lib/gdbm.t >s; mv -f s t/lib/gdbm.t
+sed -e $SDBMX -e $SDBHASH t/lib/sdbm.t >s; mv -f s t/lib/sdbm.t
+sed -e $SSTAT -e $STMP2 t/op/stat.t >s; mv -f s t/op/stat.t
+sed -e $SLIST x2p/Makefile.SH |tr -d '\r' >s; mv -f s x2p/Makefile.SH
+sed -e 's=^#define.\([A-Z]\+\)_EXP.*$=#define \1_EXP djgpp_pathexp("\1")=g' config_h.SH >s; mv -f s config_h.SH
+sed -e 's=:^/:={^([a-z]:)?[\\\\/]}=g' lib/termcap.pl >s; mv -f s lib/termcap.pl
diff --git a/djgpp/fixpmain b/djgpp/fixpmain
new file mode 100644 (file)
index 0000000..6db6555
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+# Fix perlmain.c under DOS (short & case insensitive filenames).
+# Called from Makefile.aperl when needed.
+# You don't need this when LFN=y.
+
+use Config;
+
+open (PERLM,"<perlmain.c") or die "Can't load perlmain.c: $!";
+open (MAKEFILE,"<makefile.pl") or die "Can't load makefile.pl: $!";
+undef $/;
+$perlmain=<PERLM>;
+$makefile=<MAKEFILE>;
+
+($_) = $makefile =~ /\bNAME\b.*=>\W*([\w\:]+)/; # extract module name
+$badname=join ("__",map {lc substr ($_,0,8)} split /:+/); # dosify
+$perlmain =~ s/^.*boot_$badname.*$//gm if $badname; # delete bad lines
+
+@exts=split (" ",$Config{known_extensions});
+for $realname (@exts,'DynaLoader')
+{
+    $dosname=substr (lc $realname,0,8);
+    $perlmain =~ s/boot_$dosname/boot_$realname/gm;
+    $perlmain =~ s/$dosname(::bootstrap)/$realname$1/gm;
+}
+
+#DynaLoader is special
+$perlmain =~ s/(DynaLoader:\:boot)strap/$1_DynaLoader/gm;
+
+open (PERLM,">perlmain.c") or die "Can't write perlmain.c: $!";
+print PERLM $perlmain;
diff --git a/doio.c b/doio.c
index 8413fca..cd718a9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -416,8 +416,12 @@ nextargv(register GV *gv)
 #ifndef FLEXFILENAMES
                    if (Stat(SvPVX(sv),&statbuf) >= 0
                      && statbuf.st_dev == filedev
-                     && statbuf.st_ino == fileino ) {
-                       warn("Can't do inplace edit: %s > 14 characters",
+                     && statbuf.st_ino == fileino
+#ifdef DJGPP
+                      || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
+#endif
+                      ) {
+                       warn("Can't do inplace edit: %s would not be uniq",
                          SvPVX(sv) );
                        do_close(gv,FALSE);
                        continue;
@@ -922,7 +926,7 @@ do_execfree(void)
     }
 }
 
-#if !defined(OS2) && !defined(WIN32)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP)
 
 bool
 do_exec(char *cmd)
index f44eb72..ec7b85a 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -7,9 +7,30 @@
 #ifdef DJGPP
 #  define BIT_BUCKET "nul"
 #  define OP_BINARY O_BINARY
-void Perl_DJGPP_init();
-#  define PERL_SYS_INIT(argcp, argvp) STMT_START {        \
-    Perl_DJGPP_init();    } STMT_END
+#  define PERL_SYS_INIT(c,v) Perl_DJGPP_init(c,v)
+#  include <signal.h>
+#  define HAS_UTIME
+#  define HAS_KILL
+   char *djgpp_pathexp (const char*);
+#  if (DJGPP==2 && DJGPP_MINOR < 2)
+#    define NO_LOCALECONV_MON_THOUSANDS_SEP
+#  endif
+#  ifdef USE_THREADS
+#    define NEED_PTHREAD_INIT
+#    define OLD_PTHREADS_API
+#    define YIELD pthread_yield(NULL)
+#    define DETACH(t)                          \
+       STMT_START {                            \
+         if (pthread_detach(&(t)->self)) {     \
+             MUTEX_UNLOCK(&(t)->mutex);                \
+             croak("panic: DETACH");           \
+         }                                     \
+       } STMT_END
+#    define pthread_mutexattr_default NULL
+#    define pthread_condattr_default NULL
+#    define pthread_attr_default NULL
+#    define pthread_addr_t any_t
+#  endif
 #else  /* DJGPP */
 #  ifdef WIN32
 #    define PERL_SYS_INIT(c,v) Perl_win32_init(c,v)
index 57efb83..d371455 100644 (file)
@@ -2896,9 +2896,11 @@ localeconv()
            if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
                hv_store(RETVAL, "mon_decimal_point", 17,
                    newSVpv(lcbuf->mon_decimal_point, 0), 0);
+#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
            if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
                hv_store(RETVAL, "mon_thousands_sep", 17,
                    newSVpv(lcbuf->mon_thousands_sep, 0), 0);
+#endif                    
            if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
                hv_store(RETVAL, "mon_grouping", 12,
                    newSVpv(lcbuf->mon_grouping, 0), 0);
diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh
new file mode 100644 (file)
index 0000000..85455c3
--- /dev/null
@@ -0,0 +1,63 @@
+# hints file for dos/djgpp v2.xx
+# Original by Laszlo Molnar <molnarl@cdata.tvnet.hu>
+
+# 971015 - archname changed from 'djgpp' to 'dos-djgpp'
+
+archname='dos-djgpp'
+archobjs='djgpp.o'
+path_sep=\;
+startsh="#!sh"
+
+cc='gcc'
+ld='gcc'
+usrinc="$DJDIR/include"
+
+libpth="$DJDIR/lib"
+libc="$libpth/libc.a"
+
+so='none'
+usedl='n'
+
+firstmakefile='GNUmakefile'
+exe_ext='.exe'
+
+randbits=31
+
+ln='cp'             # no REAL ln on dos
+lns='cp'
+
+usenm='true'
+d_bincompat3='undef'
+
+d_link='undef'      # these are empty functions in libc.a
+d_symlink='undef'
+d_fork='undef'
+d_pipe='undef'
+
+startperl='#!perl'
+
+case "X$optimize" in
+  X)
+       optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2"
+       ;;
+esac
+ldflags='-s'
+usemymalloc='n'
+timetype='time_t'
+
+prefix=$DJDIR
+privlib=$prefix/lib/perl5
+archlib=$privlib
+sitelib=$privlib/site
+sitearch=$sitelib
+
+: set up the translation script tr
+
+cat >../UU/tr <<EOSC
+$startsh
+case "\$1\$2" in
+'[A-Z][a-z]') exec tr.exe '[:upper:]' '[:lower:]';;
+'[a-z][A-Z]') exec tr.exe '[:lower:]' '[:upper:]';;
+esac
+exec tr.exe "\$@"
+EOSC
index b677cc2..fd11ee6 100755 (executable)
@@ -295,7 +295,7 @@ sub create_index {
     # get the list of .html files in this directory
     opendir(DIR, $dir) ||
        die "$0: error opening directory $dir for reading: $!\n";
-    @files = sort(grep(/\.html$/, readdir(DIR)));
+    @files = sort(grep(/\.html?$/, readdir(DIR)));
     closedir(DIR);
 
     open(HTML, ">$html") ||
index 465b48d..ee00cd1 100755 (executable)
@@ -37,6 +37,12 @@ umask 022;
 @pods = (<pod/*.pod>);
 
 %archpms = (Config => 1, FileHandle => 1, overload => 1);
+
+if ($^O eq 'dos') {
+    push(@scripts,'djgpp/fixpmain');
+    $archpms{config} = $archpms{filehand} = 1;
+}
+
 find(sub {
        if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) {
            (my $pm = $1) =~ s{^lib/}{};
@@ -97,9 +103,14 @@ chmod(0755, "$installbin/perl.$dlext");
 
 # First we install the version-numbered executables.
 
-safe_unlink("$installbin/perl$ver$exe_ext");
-copy("perl$exe_ext", "$installbin/perl$ver$exe_ext");
-chmod(0755, "$installbin/perl$ver$exe_ext");
+if ($^O ne 'dos') {
+    safe_unlink("$installbin/perl$ver$exe_ext");
+    copy("perl$exe_ext", "$installbin/perl$ver$exe_ext");
+    chmod(0755, "$installbin/perl$ver$exe_ext");
+} else {
+    safe_unlink("$installbin/perl.exe");
+    copy("perl.exe", "$installbin/perl.exe");
+}
 
 safe_unlink("$installbin/sperl$ver$exe_ext");
 if ($d_dosuid) {
@@ -182,7 +193,7 @@ if (!$versiononly && !$nonono && -t STDIN && -t STDERR
 
 # Make links to ordinary names if installbin directory isn't current directory.
 
-if (! $versiononly && ! samepath($installbin, '.')) {
+if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) {
     safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
     link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
     link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") 
@@ -221,7 +232,11 @@ if (! $versiononly) {
 
 if (! $versiononly) {
     safe_unlink("$installscript/pstruct");
-    link("$installscript/c2ph","$installscript/pstruct");
+    if ($^O eq 'dos') {
+        copy("$installscript/c2ph","$installscript/pstruct"); 
+    } else {
+        link("$installscript/c2ph","$installscript/pstruct");
+    }
 }
 
 # Install pod pages.  Where? I guess in $installprivlib/pod.
@@ -255,7 +270,7 @@ if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
     if (compare($from, $to) || $nonono) {
        mkpath("${installarchlib}/pod", 1, 0777);
        unlink($to);
-       link($from, $to);
+       link($from, $to) if ($^O ne 'dos');
     }
 }
 
@@ -377,6 +392,7 @@ sub link {
 sub chmod {
     local($mode,$name) = @_;
 
+    return if ($^O eq 'dos');
     printf STDERR "  chmod %o %s\n", $mode, $name;
     CORE::chmod($mode,$name)
        || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
index 8019df7..df54f15 100644 (file)
@@ -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
index 3bd0085..6952411 100644 (file)
@@ -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;
     }
 }
index 4400858..0803a99 100644 (file)
@@ -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;
 
index 4f7a9e8..6703245 100644 (file)
@@ -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;
index 0959a2f..8437346 100644 (file)
@@ -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;
index e4863f8..5c6299e 100644 (file)
@@ -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];
 }
index 033cfe5..70629d4 100644 (file)
@@ -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;
 
index 43856df..492f150 100644 (file)
@@ -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 {
index 918775c..881caa7 100644 (file)
@@ -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;
   }
index ffeb0b2..d6add62 100644 (file)
@@ -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";
                    }
@@ -1308,6 +1314,19 @@ sub pre_escape {
     $$str =~ s,&,&amp;,g;
 }
 
+#
+# 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
@@ -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;
index 2b6c6b6..96fda96 100644 (file)
@@ -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 @_;
index 5703405..1e95ec3 100644 (file)
@@ -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})) {
index df56723..ea072e0 100644 (file)
@@ -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";
index 7a89fa9..7583543 100755 (executable)
@@ -54,7 +54,7 @@ esac
 # cppstdin wrapper script.
 # Put .. and . first so that we pick up the present cppstdin, not
 # an older one lying about in /usr/local/bin.
-PATH=".:..:$PATH"
+PATH=".$path_sep..$path_sep$PATH"
 export PATH
 
 $cat /dev/null >.deptmp
diff --git a/mg.c b/mg.c
index 8a7cfdd..b032bf3 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -600,7 +600,7 @@ magic_setenv(SV *sv, MAGIC *mg)
     }
 #endif
 
-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32)
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (tainting) {
@@ -649,7 +649,7 @@ magic_setenv(SV *sv, MAGIC *mg)
            }
        }
     }
-#endif /* neither OS2 nor AMIGAOS nor WIN32 */
+#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
 
     return 0;
 }
diff --git a/perl.c b/perl.c
index f0ceaac..d5811e0 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -897,7 +897,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     boot_core_UNIVERSAL();
     if (xsinit)
        (*xsinit)();    /* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32)
+#if defined(VMS) || defined(WIN32) || defined(DJGPP)
     init_os_extras();
 #endif
 
@@ -1661,6 +1661,7 @@ moreswitches(char *s)
 #endif
 #ifdef DJGPP
        printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
+       printf("djgpp v2 port (perl5004) by Laszlo Molnar, 1997\n");
 #endif
 #ifdef OS2
        printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
@@ -2599,7 +2600,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e
            if (!(s = strchr(*env,'=')))
                continue;
            *s++ = '\0';
-#ifdef WIN32
+#if defined(WIN32) || defined(MSDOS)
            (void)strupr(*env);
 #endif
            sv = newSVpv(s--,0);
index 46f47a8..5c8afc7 100644 (file)
@@ -315,7 +315,7 @@ $cutting = 1;
 # We try first to get the version number from a local binary, in case we're
 # running an installed version of Perl to produce documentation from an
 # uninstalled newer version's pod files.
-if ($^O ne 'plan9') {
+if ($^O ne 'plan9' && $^O ne 'dos') {
   ($version,$patch) =
     `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
 }
index f4a6948..23c3a95 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1105,10 +1105,15 @@ do_readline(void)
                sv_setpv(tmpcmd, "for a in ");
                sv_catsv(tmpcmd, tmpglob);
                sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
+#else
+#ifdef DJGPP
+               sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
+               sv_catsv(tmpcmd, tmpglob);
 #else
                sv_setpv(tmpcmd, "perlglob ");
                sv_catsv(tmpcmd, tmpglob);
                sv_catpv(tmpcmd, " |");
+#endif /* !DJGPP */
 #endif /* !OS2 */
 #else /* !DOSISH */
 #if defined(CSH)
index ca82689..eae0158 100755 (executable)
--- 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;
 }
index cadbfd5..854f146 100755 (executable)
@@ -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 {
index cedc2eb..08cae71 100755 (executable)
@@ -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') {
index ebc9f56..fea0cd7 100755 (executable)
@@ -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 {
index b9c1097..3dc651b 100755 (executable)
@@ -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
index d8ebae2..2009d61 100755 (executable)
@@ -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>;
index ad25011..90dbb84 100755 (executable)
@@ -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 {
index 798adc1..5ac9e5b 100755 (executable)
@@ -1,4 +1,4 @@
-#!perl
+#!./perl
 
 BEGIN {
     chdir 't' if -d 't';
index e48b71c..80361ba 100755 (executable)
@@ -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;
 }
index 97f8192..9d4b3a6 100755 (executable)
@@ -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;
 
index 0af333d..826cf38 100755 (executable)
@@ -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';
 
index 22bb574..e18f123 100755 (executable)
@@ -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/, $@;