diff options
author | Molnar Laszlo <molnarl@cdata.tvnet.hu> | 1997-11-21 11:58:26 +0100 |
---|---|---|
committer | Malcolm Beattie <mbeattie@sable.ox.ac.uk> | 1997-12-17 14:10:50 +0000 |
commit | 39e571d41067215a80f26089b260f1418caeb36b (patch) | |
tree | e0bca433f79179f69a7b158d5bcd0759cc98e18c | |
parent | 1f70e1ea8280242937e42514e140f4e467e09404 (diff) | |
download | perl-39e571d41067215a80f26089b260f1418caeb36b.tar.gz |
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
45 files changed, 1065 insertions, 94 deletions
@@ -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 ;; @@ -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 diff --git a/Makefile.SH b/Makefile.SH index 2e90be0d73..d334525873 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -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 index 0000000000..3d1b33cbd9 --- /dev/null +++ b/README.dos @@ -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 index 0000000000..ed443d31c4 --- /dev/null +++ b/djgpp/config.over @@ -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 index 0000000000..64b46ec34f --- /dev/null +++ b/djgpp/configure.bat @@ -0,0 +1,37 @@ +@echo off
+set CONFIG=
+set PATH_SEPARATOR=;
+set PATH_EXPAND=y
+sh -c 'if test $PATH_SEPARATOR = ";"; then exit 1; fi'
+if ERRORLEVEL 1 goto path_sep_ok
+echo Error:
+echo Make sure the environment variable PATH_SEPARATOR=; while building perl!
+echo Please check your DJGPP.ENV!
+goto end
+
+:path_sep_ok
+sh -c 'if test $PATH_EXPAND = "Y" -o $PATH_EXPAND = "y"; then exit 1; fi'
+if ERRORLEVEL 1 goto path_exp_ok
+echo Error:
+echo Make sure the environment variable PATH_EXPAND=Y while building perl!
+echo Please check your DJGPP.ENV!
+goto end
+
+:path_exp_ok
+sh -c '$SHELL -c "exit 128"'
+if ERRORLEVEL 128 goto shell_ok
+
+echo Error:
+echo The SHELL environment variable must be set to the full path of your sh.exe!
+goto end
+
+:shell_ok
+sh -c 'if test ! -d /tmp; then mkdir /tmp; fi'
+cp djgpp.c config.over ..
+cd ..
+echo Running sed...
+sh djgpp/djgppsed.sh
+
+echo Running Configure...
+sh Configure %1 %2 %3 %4 %5 %6 %7 %8 %9
+:end
diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c new file mode 100644 index 0000000000..578a1f9bd7 --- /dev/null +++ b/djgpp/djgpp.c @@ -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 index 0000000000..5acf0ce8f3 --- /dev/null +++ b/djgpp/djgppsed.sh @@ -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 index 0000000000..6db6555ecf --- /dev/null +++ b/djgpp/fixpmain @@ -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; @@ -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) @@ -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) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 57efb83a42..d3714557ec 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -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 index 0000000000..85455c3852 --- /dev/null +++ b/hints/dos_djgpp.sh @@ -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 diff --git a/installhtml b/installhtml index b677cc29db..fd11ee69f4 100755 --- a/installhtml +++ b/installhtml @@ -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") || diff --git a/installperl b/installperl index 465b48d171..ee00cd16a5 100755 --- a/installperl +++ b/installperl @@ -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) 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"; diff --git a/makedepend.SH b/makedepend.SH index 7a89fa9821..7583543534 100755 --- a/makedepend.SH +++ b/makedepend.SH @@ -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 @@ -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; } @@ -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); diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 46f47a8870..5c8afc7a6d 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -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}))?/; } @@ -1106,9 +1106,14 @@ do_readline(void) 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) @@ -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/, $@; |