diff -C 2 -P -b -r perl5.004_02.ori/Configure perl5.004_02/Configure *** perl5.004_02.ori/Configure Thu Aug 7 16:08:44 1997 --- perl5.004_02/Configure Thu Aug 28 12:29:12 1997 *************** *** 23,26 **** --- 23,27 ---- # Generated on Sat Feb 1 00:26:40 EST 1997 [metaconfig 3.0 PL60] + test -d /tmp || mkdir /tmp # this is for dos cat >/tmp/c1$$ < + Only in perl5.004_02.ori: configure diff -C 2 -P -b -r perl5.004_02.ori/djgpp/config.over perl5.004_02/djgpp/config.over *** perl5.004_02.ori/djgpp/config.over Thu Jan 1 01:00:00 1970 --- perl5.004_02/djgpp/config.over Thu Aug 28 12:23:26 1997 *************** *** 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' + } + 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 -C 2 -P -b -r perl5.004_02.ori/djgpp/configure.bat perl5.004_02/djgpp/configure.bat *** perl5.004_02.ori/djgpp/configure.bat Thu Jan 1 01:00:00 1970 --- perl5.004_02/djgpp/configure.bat Wed Aug 27 14:05:06 1997 *************** *** 0 **** --- 1,36 ---- + @echo off + set CONFIG= + set PATH_SEPARATOR=; + set PATH_EXPAND=y + gcc -O2 -s -o perlglob.exe perlglob.c + cp perlglob.exe ../t + mv perlglob.exe .. + cp djgpp.c config.over .. + 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 + if not "%SHELL%" == "" 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 + cd .. + echo Running sed... + sh djgpp/djgppsed.sh + echo Running Configure... + sh Configure %1 %2 %3 %4 %5 %6 %7 %8 %9 + :end \ No newline at end of file diff -C 2 -P -b -r perl5.004_02.ori/djgpp/djgpp.c perl5.004_02/djgpp/djgpp.c *** perl5.004_02.ori/djgpp/djgpp.c Thu Jan 1 01:00:00 1970 --- perl5.004_02/djgpp/djgpp.c Fri Aug 29 11:46:51 1997 *************** *** 0 **** --- 1,423 ---- + /* 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 */ + + #include + #include + #include + #include + #include + #include + #include + #include + #include + + /* 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 = NULL; + + if (pl!=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 (strncasecmp ("perlglob ",cm,9)==0) + { + int systemflags=__system_flags; + __system_flags&=~(__system_call_cmdproc|__system_use_shell); + if ((l1->exit_status = system (cm)) == EOF) + l1->fp = NULL; + __system_flags=systemflags; + } + else + 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 */ + l1 = NULL; /* make pointer bogus */ + + return retval; /* retval==0 ? OK : ERROR */ + } + + /**************************/ + + /* this is from os2/os2.c */ + + #include "EXTERN.h" + #include "perl.h" + + int + do_aspawn(really,mark,sp) + SV *really; + register SV **mark; + register SV **sp; + { + register char **a; + char *tmps = NULL; + int rc; + int flag = P_WAIT, trueflag, err, secondtry = 0; + + if (sp > mark) { + New(1301,Argv, sp - mark + 3, char*); + a = Argv; + + if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { + ++mark; + flag = SvIVx(*mark); + } + + while (++mark <= sp) { + if (*mark) + *a++ = SvPVx(*mark, na); + else + *a++ = ""; + } + *a = Nullch; + + trueflag = flag; + + if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path; + + 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 */ + /* We should check PERL_SH* and PERLLIB_* as well? */ + retry: + if (really && *(tmps = SvPV(really, na))) + rc = spawnvp(flag,tmps,Argv); + else + rc = spawnvp(flag,Argv[0],Argv); + + if (rc < 0 && secondtry == 0 + && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */ + err = errno; + if (err == ENOENT) { /* No such file. */ + char *no_dir; + (no_dir = strrchr(Argv[0], '/')) + || (no_dir = strrchr(Argv[0], '\\')) + || (no_dir = Argv[0]); + if (!strchr(no_dir, '.')) { + struct stat buffer; + if (stat(Argv[0], &buffer) != -1) { /* File exists. */ + /* Maybe we need to specify the full name here? */ + goto doshell; + } + } + } else if (err == ENOEXEC) { /* Need to send to shell. */ + doshell: + while (a >= Argv) { + *(a + 2) = *a; + a--; + } + *Argv = sh_path; + *(Argv + 1) = "-c"; + secondtry = 1; + goto retry; + } + } + if (rc < 0 && dowarn) + warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); + if (rc > 0) + rc <<= 8; + if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + } else + rc = -1; + do_execfree(); + return rc; + } + + #define EXECF_SPAWN 0 + + int + do_spawn2(cmd, execf) + char *cmd; + int execf; + { + register char **a; + register char *s; + char *shell, *copt, *news = NULL; + int rc, added_shell = 0; + + #ifdef TRYSHELL + copt="/c"; + if ((shell = getenv("SHELL")) != NULL) + copt = "-c"; + else if ((shell = getenv("COMSPEC")) == NULL) + shell = "c:\\command.com"; + #else + /* Consensus on perl5-porters is that it is _very_ important to + have a shell which will not change between computers with the + same architecture, to avoid "action on a distance". + And to have simple build, this shell should be sh. */ + shell = sh_path; + copt = "-c"; + #endif + + while (*cmd && isSPACE(*cmd)) + cmd++; + + if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) { + STRLEN l = strlen(sh_path); + + New(1302, news, strlen(cmd) - 7 + l + 1, char); + strcpy(news, sh_path); + strcpy(news + l, cmd + 7); + cmd = news; + added_shell = 1; + } + + /* save an extra exec if possible */ + /* see if there are shell metacharacters in it */ + + 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 (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) { + if (*s == '\n' && s[1] == '\0') { + *s = '\0'; + break; + } + doshell: + rc = spawnl(P_WAIT,shell,shell,copt,cmd,(char*)0); + if (rc < 0 && dowarn) + warn("Can't %s \"%s\": %s", + "spawn", + shell, Strerror(errno)); + if (rc > 0) + rc <<= 8; + if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + if (news) Safefree(news); + return rc; + } + } + + 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]) { + int err; + + rc = spawnvp(P_WAIT,Argv[0],Argv); + if (rc < 0) { + err = errno; + if (err == ENOENT) { /* No such file. */ + char *no_dir; + (no_dir = strrchr(Argv[0], '/')) + || (no_dir = strrchr(Argv[0], '\\')) + || (no_dir = Argv[0]); + if (!strchr(no_dir, '.')) { + struct stat buffer; + if (stat(Argv[0], &buffer) != -1) { /* File exists. */ + /* Maybe we need to specify the full name here? */ + goto doshell; + } + } + } else if (err == ENOEXEC) { /* Need to send to shell. */ + goto doshell; + } + } + if (rc < 0 && dowarn) + warn("Can't %s \"%s\": %s", + "spawn", + Argv[0], Strerror(err)); + if (rc > 0) + rc <<= 8; + if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + } else + rc = -1; + if (news) Safefree(news); + do_execfree(); + return rc; + } + + int + do_spawn(cmd) + char *cmd; + { + return do_spawn2(cmd, EXECF_SPAWN); + } + + /**************************/ + + #include + #include "XSUB.h" + + static + XS(dos_GetCwd) + { + dXSARGS; + + if (items != 0) + 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); + } diff -C 2 -P -b -r perl5.004_02.ori/djgpp/djgppsed.sh perl5.004_02/djgpp/djgppsed.sh *** perl5.004_02.ori/djgpp/djgppsed.sh Thu Jan 1 01:00:00 1970 --- perl5.004_02/djgpp/djgppsed.sh Fri Aug 29 12:34:24 1997 *************** *** 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' + SLNMAKEDEP='s=ln\(.makedepend\)=cp\1=g' + SLN='s=ln\(.\.\.\)=cp\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 $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 -e $SLNMAKEDEP makedepend.SH |tr -d '\r' >s; mv -f s makedepend.SH + sed -e $SLN makedir.SH |tr -d '\r' >s; mv -f s makedir.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 |tr -d '\r' >s; mv -f s t/io/argv.t + sed -e $SABC t/io/inplace.t |tr -d '\r' >s; mv -f s t/io/inplace.t + sed -e $SDBMX t/lib/anydbm.t |tr -d '\r' >s; mv -f s t/lib/anydbm.t + sed -e $SDBMX -e $SDBHASH t/lib/gdbm.t |tr -d '\r' >s; mv -f s t/lib/gdbm.t + sed -e $SDBMX -e $SDBHASH t/lib/sdbm.t |tr -d '\r' >s; mv -f s t/lib/sdbm.t + sed -e $SSTAT -e $STMP2 t/op/stat.t |tr -d '\r' >s; mv -f s t/op/stat.t + sed -e $SLIST x2p/Makefile.SH |tr -d '\r' >s; mv -f s x2p/Makefile.SH diff -C 2 -P -b -r perl5.004_02.ori/djgpp/fixpmain perl5.004_02/djgpp/fixpmain *** perl5.004_02.ori/djgpp/fixpmain Thu Jan 1 01:00:00 1970 --- perl5.004_02/djgpp/fixpmain Fri Aug 29 16:27:12 1997 *************** *** 0 **** --- 1,30 ---- + #!perl -w + # Fix perlmain.c under DOS (short & case insensitive filenames) + # when installing a new module and `make test' fails when linking + # the new perl executable. + + # Usage: fixpmain + + use Config; + + open (PERLM,"; + $makefile=; + + ($_) = $makefile =~ /\bNAME\b.*=>\W*([\w\:]+)/; # extract module name + $badname=join ("__",map {lc substr ($_,0,8)} split /:+/); + + @exts=('DynaLoader',split (" ",$Config::Config{known_extensions})); + for $realname (@exts) + { + $dosname=substr (lc $realname,0,8); + $perlmain =~ s/boot_$dosname/boot_$realname/gm; + $perlmain =~ s/$dosname\:\:bootstrap/$realname\:\:bootstrap/gm; + } + + $perlmain =~ s/^.*boot_$badname.*$//gm if $badname; + + open (PERLM,">perlmain.c") or die "Can't write perlmain.c: $!"; + print PERLM $perlmain; diff -C 2 -P -b -r perl5.004_02.ori/djgpp/perlglob.c perl5.004_02/djgpp/perlglob.c *** perl5.004_02.ori/djgpp/perlglob.c Thu Jan 1 01:00:00 1970 --- perl5.004_02/djgpp/perlglob.c Wed Aug 13 19:48:54 1997 *************** *** 0 **** --- 1,16 ---- + #include + + #ifndef __DJGPP__ + error This perlglob only works with DJGPP! + #endif /* __DJGPP__ */ + + #include + void __crt0_load_environment_file (char *app_name) {} + + int main (int argc,char **argv) + { + int ic; + setmode (1,O_BINARY); + for (ic=1; ic ! # define HAS_UTIME ! # define HAS_KILL #else /* DJGPP */ # ifdef WIN32 diff -C 2 -P -b -r perl5.004_02.ori/ext/POSIX/POSIX.xs perl5.004_02/ext/POSIX/POSIX.xs *** perl5.004_02.ori/ext/POSIX/POSIX.xs Tue Aug 5 15:03:01 1997 --- perl5.004_02/ext/POSIX/POSIX.xs Wed Aug 13 19:48:54 1997 *************** *** 2970,2976 **** --- 2970,2978 ---- hv_store(RETVAL, "mon_decimal_point", 17, newSVpv(lcbuf->mon_decimal_point, 0), 0); + #ifndef DJGPP 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, diff -C 2 -P -b -r perl5.004_02.ori/hints/dos_djgpp.sh perl5.004_02/hints/dos_djgpp.sh *** perl5.004_02.ori/hints/dos_djgpp.sh Thu Jan 1 01:00:00 1970 --- perl5.004_02/hints/dos_djgpp.sh Thu Aug 28 12:48:17 1997 *************** *** 0 **** --- 1,56 ---- + # hints file for dos/djgpp v2.xx + # Original by Laszlo Molnar + + archname='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 + + : set up the translation script tr + + cat >../UU/tr <); %archpms = (Config => 1, FileHandle => 1, overload => 1); + $archpms{config} = 1 if $Is_Dos; + $archpms{filehand} = 1 if $Is_Dos; find(sub { if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) { *************** *** 87,93 **** # 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"); safe_unlink("$installbin/sperl$ver$exe_ext"); --- 91,104 ---- # First we install the version-numbered executables. ! if (!Is_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", "$installbin/perlglob.exe"); ! copy("perl.exe", "$installbin/perl.exe"); ! copy("perlglob.exe", "$installbin/perlglob.exe"); ! system("djp", "$installbin/perl.exe", "$installbin/perlglob.exe"); ! } safe_unlink("$installbin/sperl$ver$exe_ext"); *************** *** 172,176 **** # Make links to ordinary names if installbin directory isn't current directory. ! if (! $versiononly && ! samepath($installbin, '.')) { safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); --- 183,187 ---- # Make links to ordinary names if installbin directory isn't current directory. ! if (! $versiononly && ! samepath($installbin, '.') && ! Is_Dos) { safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); *************** *** 183,186 **** --- 194,198 ---- copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext"); chmod(0755, "$installbin/a2p$exe_ext"); + system ("djp", "$installbin/a2p$exe_ext") if $Is_Dos; } *************** *** 211,215 **** --- 223,231 ---- if (! $versiononly) { safe_unlink("$installscript/pstruct"); + if ($Is_Dos) { + copy("$installscript/c2ph","$installscript/pstruct"); + } else { link("$installscript/c2ph","$installscript/pstruct"); + } } *************** *** 245,249 **** mkpath("${installarchlib}/pod", 1, 0777); unlink($to); ! link($from, $to); } } --- 261,265 ---- mkpath("${installarchlib}/pod", 1, 0777); unlink($to); ! link($from, $to) if (!$Is_Dos); } } *************** *** 367,370 **** --- 383,387 ---- local($mode,$name) = @_; + return if $Is_Dos; printf STDERR " chmod %o %s\n", $mode, $name; CORE::chmod($mode,$name) *************** *** 404,408 **** # ignore patch backups and the .exists files. ! return if $name =~ m{\.orig$|~$|^\.exists}; $name = "$dir/$name" if $dir ne ''; --- 421,425 ---- # ignore patch backups and the .exists files. ! return if $name =~ m{\.orig$|~$|^[._]exists}; $name = "$dir/$name" if $dir ne ''; diff -C 2 -P -b -r perl5.004_02.ori/lib/AutoSplit.pm perl5.004_02/lib/AutoSplit.pm *** perl5.004_02.ori/lib/AutoSplit.pm Fri Jun 13 16:03:11 1997 --- perl5.004_02/lib/AutoSplit.pm Thu Aug 28 14:53:02 1997 *************** *** 106,109 **** --- 106,112 ---- $maxflen = 255; $maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; + if (defined (&Dos::UseLFN)) { + $maxflen = Dos::UseLFN() ? 255 : 11; + } $Is_VMS = ($^O eq 'VMS'); *************** *** 200,204 **** 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 $Is_VMS && $filename =~ m/$modpname.pm/i); --- 203,207 ---- die "Package $package ($modpname.pm) does not match filename $filename" unless ($filename =~ m/\Q$modpname.pm\E$/ or ! ($^O eq 'dos') or ($^O eq 'MSWin32') or $Is_VMS && $filename =~ m/$modpname.pm/i); *************** *** 248,251 **** --- 251,256 ---- # 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); *************** *** 270,278 **** 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); }else{ ! push(@names, $lname); print " writing $lpath\n" if ($Verbose>=2); } --- 275,282 ---- unless(open(OUT, ">$lpath")){ open(OUT, ">$spath") or die "Can't create $spath: $!\n"; ! push(@names, $Is83 ? lc $sname : $sname); ! print " writing $spath (with truncated name)\n" if ($Verbose>=1); }else{ ! push(@names, $Is83 ? lc substr ($lname,0,8) : $lname); print " writing $lpath\n" if ($Verbose>=2); } *************** *** 311,314 **** --- 315,319 ---- 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); diff -C 2 -P -b -r perl5.004_02.ori/lib/Cwd.pm perl5.004_02/lib/Cwd.pm *** perl5.004_02.ori/lib/Cwd.pm Thu Apr 17 20:21:30 1997 --- perl5.004_02/lib/Cwd.pm Thu Aug 28 13:32:47 1997 *************** *** 180,184 **** sub chdir_init { ! if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); --- 180,184 ---- sub chdir_init { ! if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); *************** *** 330,337 **** *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; ! sub _msdos_cwd { $ENV{'PWD'} = `command /c cd`; chop $ENV{'PWD'}; $ENV{'PWD'} =~ s:\\:/:g ; return $ENV{'PWD'}; } --- 330,341 ---- *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; ! 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'}; } *************** *** 364,372 **** *abs_path = \&fast_abs_path; } ! elsif ($^O eq 'msdos') { ! *cwd = \&_msdos_cwd; ! *getcwd = \&_msdos_cwd; ! *fastgetcwd = \&_msdos_cwd; ! *fastcwd = \&_msdos_cwd; *abs_path = \&fast_abs_path; } --- 368,376 ---- *abs_path = \&fast_abs_path; } ! elsif ($^O eq 'dos') { ! *cwd = \&_dos_cwd; ! *getcwd = \&_dos_cwd; ! *fastgetcwd = \&_dos_cwd; ! *fastcwd = \&_dos_cwd; *abs_path = \&fast_abs_path; } diff -C 2 -P -b -r perl5.004_02.ori/lib/ExtUtils/Install.pm perl5.004_02/lib/ExtUtils/Install.pm *** perl5.004_02.ori/lib/ExtUtils/Install.pm Fri Aug 1 20:36:58 1997 --- perl5.004_02/lib/ExtUtils/Install.pm Thu Aug 28 12:39:12 1997 *************** *** 12,16 **** $Is_VMS = $^O eq 'VMS'; ! my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':'; my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || ''; my $Inc_uninstall_warn_handler; --- 12,16 ---- $Is_VMS = $^O eq 'VMS'; ! 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 -C 2 -P -b -r perl5.004_02.ori/lib/ExtUtils/MM_Unix.pm perl5.004_02/lib/ExtUtils/MM_Unix.pm *** perl5.004_02.ori/lib/ExtUtils/MM_Unix.pm Tue Aug 5 15:28:08 1997 --- perl5.004_02/lib/ExtUtils/MM_Unix.pm Thu Aug 28 12:39:21 1997 *************** *** 6,10 **** use DirHandle; use strict; ! use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Verbose %pm %static $Xsubpp_Version); --- 6,10 ---- use DirHandle; use strict; ! use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Verbose %pm %static $Xsubpp_Version); *************** *** 18,21 **** --- 18,22 ---- $Is_Mac = $^O eq 'MacOS'; $Is_Win32 = $^O eq 'MSWin32'; + $Is_Dos = $^O eq 'dos'; if ($Is_VMS = $^O eq 'VMS') { *************** *** 267,271 **** .C$(OBJ_EXT): $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C ! ' if $^O ne 'os2' and $^O ne 'MSWin32'; # Case-specific push @m, ' .cpp$(OBJ_EXT): --- 268,272 ---- .C$(OBJ_EXT): $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C ! ' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific push @m, ' .cpp$(OBJ_EXT): *************** *** 1050,1054 **** --- 1051,1060 ---- sub file_name_is_absolute { my($self,$file) = @_; + if ($Is_Dos){ + $file =~ m{^([a-z]:)?[\\/]}i ; + } + else { $file =~ m:^/: ; + } } *************** *** 2571,2575 **** sub path { my($self) = @_; ! my $path_sep = $Is_OS2 ? ";" : ":"; my $path = $ENV{PATH}; $path =~ s:\\:/:g if $Is_OS2; --- 2577,2581 ---- sub path { my($self) = @_; ! my $path_sep = ($Is_OS2 || $Is_Dos) ? ";" : ":"; my $path = $ENV{PATH}; $path =~ s:\\:/:g if $Is_OS2; diff -C 2 -P -b -r perl5.004_02.ori/lib/ExtUtils/Manifest.pm perl5.004_02/lib/ExtUtils/Manifest.pm *** perl5.004_02.ori/lib/ExtUtils/Manifest.pm Fri Mar 14 23:14:10 1997 --- perl5.004_02/lib/ExtUtils/Manifest.pm Fri Aug 29 01:18:02 1997 *************** *** 88,95 **** --- 88,101 ---- 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; diff -C 2 -P -b -r perl5.004_02.ori/lib/File/Basename.pm perl5.004_02/lib/File/Basename.pm *** perl5.004_02.ori/lib/File/Basename.pm Wed Apr 16 19:47:42 1997 --- perl5.004_02/lib/File/Basename.pm Thu Aug 28 12:57:26 1997 *************** *** 142,146 **** if (@_) { $Fileparse_fstype = $_[0]; ! $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32)/i); } wantarray ? @old : $old[0]; --- 142,146 ---- if (@_) { $Fileparse_fstype = $_[0]; ! $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i); } wantarray ? @old : $old[0]; diff -C 2 -P -b -r perl5.004_02.ori/lib/File/Find.pm perl5.004_02/lib/File/Find.pm *** perl5.004_02.ori/lib/File/Find.pm Thu Jul 31 23:10:02 1997 --- perl5.004_02/lib/File/Find.pm Thu Aug 28 12:39:00 1997 *************** *** 271,275 **** $dont_use_nlink = 1 ! if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos'; 1; --- 271,275 ---- $dont_use_nlink = 1 ! if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos'; 1; diff -C 2 -P -b -r perl5.004_02.ori/lib/File/Path.pm perl5.004_02/lib/File/Path.pm *** perl5.004_02.ori/lib/File/Path.pm Fri Aug 1 00:57:26 1997 --- perl5.004_02/lib/File/Path.pm Thu Aug 28 12:39:06 1997 *************** *** 112,116 **** # 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' || $^O eq 'amigaos'); --- 112,116 ---- # 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 'dos' || $^O eq 'MSWin32' || $^O eq 'amigaos'); diff -C 2 -P -b -r perl5.004_02.ori/lib/Pod/Html.pm perl5.004_02/lib/Pod/Html.pm *** perl5.004_02.ori/lib/Pod/Html.pm Thu Jul 31 23:01:47 1997 --- perl5.004_02/lib/Pod/Html.pm Thu Aug 28 12:41:07 1997 *************** *** 200,203 **** --- 200,205 ---- 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"; *************** *** 245,249 **** #%items = (); # associative array used to find the location # of =item directives referenced by C<> links ! } --- 247,251 ---- #%items = (); # associative array used to find the location # of =item directives referenced by C<> links ! $Is83=$^O eq 'dos'; } *************** *** 255,258 **** --- 257,262 ---- init_globals(); + $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN()); + # cache of %pages and %items from last time we ran pod2html *************** *** 1064,1067 **** --- 1068,1073 ---- if (defined $pages{$2}) { # is a link qq($1$2); + } elsif (defined $pages{dosify($2)}) { # is a link + qq($1$2); } else { "$1$2"; *************** *** 1310,1313 **** --- 1316,1332 ---- # + # 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 *************** *** 1321,1325 **** sub process_L { my($str) = @_; ! my($s1, $s2, $linktext, $page, $section, $link); # work strings $str =~ s/\n/ /g; # undo word-wrapped tags --- 1340,1344 ---- sub process_L { my($str) = @_; ! my($s1, $s2, $linktext, $page, $page83, $section, $link); # work strings $str =~ s/\n/ /g; # undo word-wrapped tags *************** *** 1347,1350 **** --- 1366,1371 ---- } + $page83=dosify($page); + $page=$page83 if (defined $pages{$page83}); if ($page eq "") { $link = "#" . htmlify(0,$section); diff -C 2 -P -b -r perl5.004_02.ori/lib/Pod/Text.pm perl5.004_02/lib/Pod/Text.pm *** perl5.004_02.ori/lib/Pod/Text.pm Thu Jul 31 22:47:58 1997 --- perl5.004_02/lib/Pod/Text.pm Thu Aug 28 12:38:52 1997 *************** *** 80,84 **** || $ENV{COLUMNS} || ($ENV{TERMCAP} =~ /co#(\d+)/)[0] ! || ($^O ne 'MSWin32' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]) || 72; --- 80,84 ---- || $ENV{COLUMNS} || ($ENV{TERMCAP} =~ /co#(\d+)/)[0] ! || ($^O ne 'MSWin32' && $^O ne 'dos' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]) || 72; diff -C 2 -P -b -r perl5.004_02.ori/makedepend.SH perl5.004_02/makedepend.SH *** perl5.004_02.ori/makedepend.SH Thu Oct 10 20:48:28 1996 --- perl5.004_02/makedepend.SH Tue Aug 26 21:36:20 1997 *************** *** 49,53 **** # Put .. and . first so that we pick up the present cppstdin, not # an older one lying about in /usr/local/bin. ! PATH=".:..:$PATH" export PATH --- 49,53 ---- # Put .. and . first so that we pick up the present cppstdin, not # an older one lying about in /usr/local/bin. ! PATH=".$path_sep..$path_sep$PATH" export PATH diff -C 2 -P -b -r perl5.004_02.ori/mg.c perl5.004_02/mg.c *** perl5.004_02.ori/mg.c Tue Aug 5 15:25:59 1997 --- perl5.004_02/mg.c Wed Aug 13 19:48:54 1997 *************** *** 592,596 **** #endif ! #if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) /* And you'll never guess what the dog had */ /* in its mouth... */ --- 592,596 ---- #endif ! #if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS) /* And you'll never guess what the dog had */ /* in its mouth... */ *************** *** 640,644 **** } } ! #endif /* neither OS2 nor AMIGAOS nor WIN32 */ return 0; --- 640,644 ---- } } ! #endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */ return 0; diff -C 2 -P -b -r perl5.004_02.ori/perl.c perl5.004_02/perl.c *** perl5.004_02.ori/perl.c Tue Aug 5 15:38:36 1997 --- perl5.004_02/perl.c Tue Aug 19 15:03:04 1997 *************** *** 773,777 **** if (xsinit) (*xsinit)(); /* in case linked C routines want magical variables */ ! #if defined(VMS) || defined(WIN32) init_os_extras(); #endif --- 773,777 ---- if (xsinit) (*xsinit)(); /* in case linked C routines want magical variables */ ! #if defined(VMS) || defined(WIN32) || defined(DJGPP) init_os_extras(); #endif *************** *** 2433,2437 **** continue; *s++ = '\0'; ! #ifdef WIN32 (void)strupr(*env); #endif --- 2433,2437 ---- continue; *s++ = '\0'; ! #if defined(WIN32) || defined(MSDOS) (void)strupr(*env); #endif diff -C 2 -P -b -r perl5.004_02.ori/t/io/fs.t perl5.004_02/t/io/fs.t *** perl5.004_02.ori/t/io/fs.t Thu Apr 10 16:24:13 1997 --- perl5.004_02/t/io/fs.t Thu Aug 28 12:38:23 1997 *************** *** 10,13 **** --- 10,15 ---- use Config; + $Is_Dos=$^O eq 'dos'; + # avoid win32 (for now) do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32'; *************** *** 31,45 **** close(fh); ! if (eval {link('a','b')}) {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";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('c'); ! if ($Config{dont_use_nlink} || $nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";} ! if (($mode & 0777) == 0666 || $^O eq 'amigaos') {print "ok 5\n";} else {print "not ok 5\n";} --- 33,47 ---- close(fh); ! if (eval {link('a','b')} || $Is_Dos) {print "ok 2\n";} else {print "not ok 2\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 || $Is_Dos) {print "ok 4\n";} else {print "not ok 4\n";} ! if (($mode & 0777) == 0666 || $^O eq 'amigaos' || $Is_Dos) {print "ok 5\n";} else {print "not ok 5\n";} *************** *** 48,63 **** ($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 ((chmod 0700,'c','x') == 2) {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";} ($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 ((unlink 'b','x') == 2) {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'); --- 50,65 ---- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('c'); ! if (($mode & 0777) == 0777 || $Is_Dos) {print "ok 7\n";} else {print "not ok 7\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 || $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 || $Is_Dos) {print "ok 10\n";} else {print "not ok 10\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'); *************** *** 77,81 **** if ($ino) {print "ok 17\n";} else {print "not ok 17\n";} if (($atime == 500000000 && $mtime == 500000001) ! || $wd =~ m#/afs/# || $^O eq 'amigaos') {print "ok 18\n";} else --- 79,83 ---- if ($ino) {print "ok 17\n";} else {print "not ok 17\n";} if (($atime == 500000000 && $mtime == 500000001) ! || $wd =~ m#/afs/# || $^O eq 'amigaos' || $Is_Dos) {print "ok 18\n";} else *************** *** 121,126 **** --- 123,134 ---- 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 -C 2 -P -b -r perl5.004_02.ori/t/lib/anydbm.t perl5.004_02/t/lib/anydbm.t *** perl5.004_02.ori/t/lib/anydbm.t Fri Apr 4 18:03:34 1997 --- perl5.004_02/t/lib/anydbm.t Thu Aug 28 12:37:49 1997 *************** *** 23,27 **** ($Dfile) = ; } ! if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { print "ok 2\n"; } --- 23,27 ---- ($Dfile) = ; } ! if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') { print "ok 2\n"; } diff -C 2 -P -b -r perl5.004_02.ori/t/lib/filehand.t perl5.004_02/t/lib/filehand.t *** perl5.004_02.ori/t/lib/filehand.t Tue Aug 5 15:38:36 1997 --- perl5.004_02/t/lib/filehand.t Thu Aug 28 12:37:56 1997 *************** *** 65,68 **** --- 65,74 ---- print "ok 10\n"; + if ($^O eq 'dos') + { + printf("ok %d\n",11); + exit(0); + } + ($rd,$wr) = FileHandle::pipe; diff -C 2 -P -b -r perl5.004_02.ori/t/lib/gdbm.t perl5.004_02/t/lib/gdbm.t *** perl5.004_02.ori/t/lib/gdbm.t Fri Aug 1 17:06:36 1997 --- perl5.004_02/t/lib/gdbm.t Thu Aug 28 12:38:07 1997 *************** *** 25,29 **** ($Dfile) = ; } ! if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { print "ok 2\n"; } --- 25,29 ---- ($Dfile) = ; } ! if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') { print "ok 2\n"; } diff -C 2 -P -b -r perl5.004_02.ori/t/lib/io_sel.t perl5.004_02/t/lib/io_sel.t *** perl5.004_02.ori/t/lib/io_sel.t Fri Mar 21 03:50:33 1997 --- perl5.004_02/t/lib/io_sel.t Thu Aug 28 12:38:12 1997 *************** *** 50,54 **** print "ok 9\n"; ! if ($^O eq 'MSWin32') { # 4-arg select is only valid on sockets print "# skipping tests 10..15\n"; for (10 .. 15) { print "ok $_\n" } --- 50,54 ---- print "ok 9\n"; ! 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" } diff -C 2 -P -b -r perl5.004_02.ori/t/lib/sdbm.t perl5.004_02/t/lib/sdbm.t *** perl5.004_02.ori/t/lib/sdbm.t Fri Aug 1 17:06:36 1997 --- perl5.004_02/t/lib/sdbm.t Thu Aug 28 12:38:17 1997 *************** *** 28,32 **** ($Dfile) = ; } ! if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { print "ok 2\n"; } --- 28,32 ---- ($Dfile) = ; } ! if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') { print "ok 2\n"; } diff -C 2 -P -b -r perl5.004_02.ori/t/op/magic.t perl5.004_02/t/op/magic.t *** perl5.004_02.ori/t/op/magic.t Fri Aug 1 00:48:24 1997 --- perl5.004_02/t/op/magic.t Thu Aug 28 12:37:12 1997 *************** *** 22,32 **** $Is_MSWin32 = $^O eq 'MSWin32'; $Is_VMS = $^O eq 'VMS'; $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"; } unlink 'ajslkdfpqjsjfk'; --- 22,33 ---- $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"; } unlink 'ajslkdfpqjsjfk'; *************** *** 36,40 **** close FOO; # just mention it, squelch used-only-once ! if ($Is_MSWin32) { ok 3,1; ok 4,1; --- 37,41 ---- close FOO; # just mention it, squelch used-only-once ! if ($Is_MSWin32 || $Is_Dos) { ok 3,1; ok 4,1; *************** *** 149,156 **** --- 150,159 ---- 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), $!; *************** *** 162,166 **** ok 28, $^T > 850000000, $^T; ! if ($Is_VMS) { ok 29, 1; ok 30, 1; --- 165,169 ---- ok 28, $^T > 850000000, $^T; ! if ($Is_VMS || $Is_Dos) { ok 29, 1; ok 30, 1; diff -C 2 -P -b -r perl5.004_02.ori/t/op/stat.t perl5.004_02/t/op/stat.t *** perl5.004_02.ori/t/op/stat.t Tue Aug 5 15:31:35 1997 --- perl5.004_02/t/op/stat.t Thu Aug 28 12:37:29 1997 *************** *** 13,19 **** $Is_MSWin32 = $^O eq 'MSWin32'; chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`)); ! $DEV = `ls -l /dev` unless $Is_MSWin32; unlink "Op.stat.tmp"; --- 13,20 ---- $Is_MSWin32 = $^O eq 'MSWin32'; + $Is_Dos = $^O eq 'dos'; chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`)); ! $DEV = `ls -l /dev` unless ($Is_MSWin32 || $Is_Dos); unlink "Op.stat.tmp"; *************** *** 21,25 **** # hack to make Apollo update link count: ! $junk = `ls Op.stat.tmp` unless $Is_MSWin32; ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, --- 22,26 ---- # hack to make Apollo update link count: ! $junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos); ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, *************** *** 34,38 **** sleep 2; ! if ($Is_MSWin32) { unlink "Op.stat.tmp2" } else { `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; --- 35,39 ---- sleep 2; ! 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`; *************** *** 42,49 **** $blksize,$blocks) = stat('Op.stat.tmp'); ! if ($Is_MSWin32 || $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') { print "ok 4\n"; } --- 43,50 ---- $blksize,$blocks) = stat('Op.stat.tmp'); ! 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 || $Is_Dos || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') { print "ok 4\n"; } *************** *** 71,75 **** 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 (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";} eval '$> = $olduid;'; # switch uid back (may not be implemented) --- 72,76 ---- chmod 0,'Op.stat.tmp'; eval '$> = 1;'; # so switch uid (may not be implemented) ! 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) *************** *** 86,90 **** 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 (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";} --- 87,91 ---- 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 $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";} *************** *** 94,98 **** if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";} ! if (!$Is_MSWin32 and `ls -l perl` =~ /^l.*->/) { if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";} } --- 95,99 ---- if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";} ! if (!($Is_MSWin32 || $Is_Dos) and `ls -l perl` =~ /^l.*->/) { if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";} } *************** *** 107,111 **** if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} ! if ($Is_MSWin32) {print "ok 29\n";} elsif ($DEV !~ /\nc.* (\S+)\n/) --- 108,112 ---- if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} ! if ($Is_MSWin32 || $Is_Dos) {print "ok 29\n";} elsif ($DEV !~ /\nc.* (\S+)\n/) *************** *** 117,121 **** if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";} ! if ($Is_MSWin32) {print "ok 31\n";} elsif ($DEV !~ /\ns.* (\S+)\n/) --- 118,122 ---- if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";} ! if ($Is_MSWin32 || $Is_Dos) {print "ok 31\n";} elsif ($DEV !~ /\ns.* (\S+)\n/) *************** *** 127,131 **** if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";} ! if ($Is_MSWin32) {print "ok 33\n";} elsif ($DEV !~ /\nb.* (\S+)\n/) --- 128,132 ---- if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";} ! if ($Is_MSWin32 || $Is_Dos) {print "ok 33\n";} elsif ($DEV !~ /\nb.* (\S+)\n/) *************** *** 137,141 **** 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;} $cnt = $uid = 0; --- 138,142 ---- if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} ! if ($^O eq 'amigaos' or $Is_MSWin32 || $Is_Dos) {print "ok 35\n"; goto tty_test;} $cnt = $uid = 0; diff -C 2 -P -b -r perl5.004_02.ori/t/op/sysio.t perl5.004_02/t/op/sysio.t *** perl5.004_02.ori/t/op/sysio.t Fri Apr 18 18:08:19 1997 --- perl5.004_02/t/op/sysio.t Thu Aug 28 12:37:37 1997 *************** *** 7,11 **** open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!"; ! $reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32'); $x = 'abc'; --- 7,11 ---- open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!"; ! $reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos'); $x = 'abc'; diff -C 2 -P -b -r perl5.004_02.ori/t/op/taint.t perl5.004_02/t/op/taint.t *** perl5.004_02.ori/t/op/taint.t Fri Jun 13 16:14:49 1997 --- perl5.004_02/t/op/taint.t Thu Aug 28 12:37:43 1997 *************** *** 18,21 **** --- 18,22 ---- 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'; *************** *** 97,101 **** test 1, eval { `$echo 1` } eq "1\n"; ! if ($Is_MSWin32 || $Is_VMS) { print "# Environment tainting tests skipped\n"; for (2..5) { print "ok $_\n" } --- 98,102 ---- test 1, eval { `$echo 1` } eq "1\n"; ! if ($Is_MSWin32 || $Is_VMS || $Is_Dos) { print "# Environment tainting tests skipped\n"; for (2..5) { print "ok $_\n" } *************** *** 121,125 **** my $tmp; ! if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32) { print "# all directories are writeable\n"; } --- 122,126 ---- my $tmp; ! if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) { print "# all directories are writeable\n"; } *************** *** 350,354 **** 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 68, eval { open FOO, "> $foo" } eq '', 'open for write'; --- 351,355 ---- test 65, eval { open FOO, $foo } eq '', 'open for read'; test 66, $@ eq '', $@; # NB: This should be allowed ! test 67, $! == ($Config{"archname"} ne "djgpp" ? 2 : 22); # File not found test 68, eval { open FOO, "> $foo" } eq '', 'open for write'; diff -C 2 -P -b -r perl5.004_02.ori/utils/perldoc.PL perl5.004_02/utils/perldoc.PL *** perl5.004_02.ori/utils/perldoc.PL Tue Jul 29 02:23:32 1997 --- perl5.004_02/utils/perldoc.PL Thu Aug 28 12:32:58 1997 *************** *** 61,64 **** --- 61,65 ---- $Is_VMS = $^O eq 'VMS'; $Is_MSWin32 = $^O eq 'MSWin32'; + $Is_Dos = $^O eq 'dos'; sub usage{ *************** *** 107,111 **** if ($opt_t + $opt_u + $opt_m + $opt_l > 1) { usage("only one of -t, -u, -m or -l") ! } elsif ($Is_MSWin32) { $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l; } --- 108,112 ---- if ($opt_t + $opt_u + $opt_m + $opt_l > 1) { usage("only one of -t, -u, -m or -l") ! } elsif ($Is_MSWin32 || $Is_Dos) { $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l; } *************** *** 138,142 **** my($file) = @_; # on a case-forgiving file system we can simply use -f $file ! if ($Is_VMS or $Is_MSWin32 or $^O eq 'os2') { return ( -f $file ) ? $file : ''; } --- 139,143 ---- my($file) = @_; # on a case-forgiving file system we can simply use -f $file ! if ($Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') { return ( -f $file ) ? $file : ''; } *************** *** 187,191 **** or ( $^O eq 'os2' and $ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret)) ! or ( ($Is_MSWin32 or $^O eq 'os2') and $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret)) or ( $ret = minus_f_nocase "$dir/pod/$s.pod") --- 188,192 ---- or ( $^O eq 'os2' and $ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret)) ! or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret)) or ( $ret = minus_f_nocase "$dir/pod/$s.pod") *************** *** 260,263 **** --- 261,269 ---- $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$; push @pagers, qw( most more less type/page ); + } elsif ($Is_Dos) { + $tmp = "$ENV{TEMP}\\perldoc1.$$"; + $tmp =~ tr/\\//s; + push @pagers, qw( less more< ); + unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } else { if ($^O eq 'os2') {