The only cases when the shell is not used is the multi-argument
system() (see L<perlfunc/system>)/exec() (see L<perlfunc/exec>), and
one-argument version thereof without redirection and shell
-meta-characters.
+meta-characters. Perl may also start scripts which start with cookies
+C<extproc> or C<#!> directly, without an intervention of shell.
+
+If starting scripts directly, Perl will use exactly the same algorithm as for
+the search of script given by B<-S> command-line option: it will look in
+the current directory, then on components of C<$ENV{PATH}> using the
+following order of appended extensions: no extension, F<.cmd>, F<.btm>,
+F<.bat>, F<.pl>.
+
+Note that Perl will start to look for scripts only if OS/2 cannot start the
+specified application, thus C<system 'blah'> will not look for a script if
+there is an executable file F<blah.exe> I<anywhere> on C<PATH>.
+
+Note also that executable files on OS/2 can have an arbitrary extension,
+but F<.exe> will be automatically appended if no dot is present in the name.
+The workaround as as simple as that: since F<blah.> and F<blah> denote the
+same file, to start an executable residing in file F<n:/bin/blah> (no
+extension) give an argument C<n:/bin/blah.> to system().
+
+The last note is that currently it is not straightforward to start PM
+programs from VIO (=text-mode) Perl process and visa versa. Either ensure
+that shell will be used, as in C<system 'cmd /c epm'>, or start it using
+optional arguments to system() documented in C<OS2::Process> module. This
+is considered a bug and should be fixed soon.
+
=head1 Frequently asked questions
=head2 Testing
+If you haven't yet moved perl.dll onto LIBPATH, do it now(alternatively, if
+you have a previous perl installation you'd rather not disrupt until this one
+is installed, copy perl.dll to the t directory).
+
Now run
make test
=head2 Installing the built perl
+If you haven't yet moved perl.dll onto LIBPATH, do it now.
+
Run
make install
6) Optionally define the command PERLDOC as
PERLDOC :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T
+Note that if you wish to use most as a pager please see
+ftp://space.mit.edu/pub/davis/ for both most and slang.
7) Optionally define the command PERLBUG (the Perl bug report generator) as
PERLBUG :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
POD2MAN :== $PERL_ROOT:[000000]PERL POD2MAN
+8) Optionally define the command POD2MAN (Converts POD files to nroff
+source suitable for converting to man pages. Also quiets complaints during
+module builds) as
+
+DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
+POD2MAN :== $PERL_ROOT:[000000]PERL POD2MAN
+
* Installing Perl into DCLTABLES
Courtesy of Brad Hughes:
#define G_EVAL 4 /* Assume eval {} around subroutine call. */
#define G_NOARGS 8 /* Don't construct a @_ array. */
#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
+#define G_NODEBUG 32 /* Disable debugging at toplevel. */
/* Support for switching (stack and block) contexts.
* This ensures magic doesn't invalidate local stack and cx pointers.
* unresolved references in situations like this. */
/* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */
}
+ /* BIND_NOSTART removed from bind_type because it causes the shared library's */
+ /* initialisers not to be run. This causes problems with all of the static objects */
+ /* in the library. */
#ifdef DEBUGGING
if (dl_debug)
bind_type |= BIND_VERBOSE;
for (i = 0; i <= max; i++) {
char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym));
- obj = shl_load(sym, bind_type | BIND_NOSTART, 0L);
+ obj = shl_load(sym, bind_type, 0L);
if (obj == NULL) {
goto end;
}
}
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename));
- obj = shl_load(filename, bind_type | BIND_NOSTART, 0L);
+ obj = shl_load(filename, bind_type, 0L);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj));
end:
case '_':
if (strnEQ(name, "_PC_", 4)) {
if (strEQ(name, "_PC_CHOWN_RESTRICTED"))
-#ifdef _PC_CHOWN_RESTRICTED
+#if defined(_PC_CHOWN_RESTRICTED) || HINT_SC_EXIST
return _PC_CHOWN_RESTRICTED;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_LINK_MAX"))
-#ifdef _PC_LINK_MAX
+#if defined(_PC_LINK_MAX) || HINT_SC_EXIST
return _PC_LINK_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_MAX_CANON"))
-#ifdef _PC_MAX_CANON
+#if defined(_PC_MAX_CANON) || HINT_SC_EXIST
return _PC_MAX_CANON;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_MAX_INPUT"))
-#ifdef _PC_MAX_INPUT
+#if defined(_PC_MAX_INPUT) || HINT_SC_EXIST
return _PC_MAX_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_NAME_MAX"))
-#ifdef _PC_NAME_MAX
+#if defined(_PC_NAME_MAX) || HINT_SC_EXIST
return _PC_NAME_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_NO_TRUNC"))
-#ifdef _PC_NO_TRUNC
+#if defined(_PC_NO_TRUNC) || HINT_SC_EXIST
return _PC_NO_TRUNC;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_PATH_MAX"))
-#ifdef _PC_PATH_MAX
+#if defined(_PC_PATH_MAX) || HINT_SC_EXIST
return _PC_PATH_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_PIPE_BUF"))
-#ifdef _PC_PIPE_BUF
+#if defined(_PC_PIPE_BUF) || HINT_SC_EXIST
return _PC_PIPE_BUF;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_VDISABLE"))
-#ifdef _PC_VDISABLE
+#if defined(_PC_VDISABLE) || HINT_SC_EXIST
return _PC_VDISABLE;
#else
goto not_there;
}
if (strnEQ(name, "_SC_", 4)) {
if (strEQ(name, "_SC_ARG_MAX"))
-#ifdef _SC_ARG_MAX
+#if defined(_SC_ARG_MAX) || HINT_SC_EXIST
return _SC_ARG_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_CHILD_MAX"))
-#ifdef _SC_CHILD_MAX
+#if defined(_SC_CHILD_MAX) || HINT_SC_EXIST
return _SC_CHILD_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_CLK_TCK"))
-#ifdef _SC_CLK_TCK
+#if defined(_SC_CLK_TCK) || HINT_SC_EXIST
return _SC_CLK_TCK;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_JOB_CONTROL"))
-#ifdef _SC_JOB_CONTROL
+#if defined(_SC_JOB_CONTROL) || HINT_SC_EXIST
return _SC_JOB_CONTROL;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_NGROUPS_MAX"))
-#ifdef _SC_NGROUPS_MAX
+#if defined(_SC_NGROUPS_MAX) || HINT_SC_EXIST
return _SC_NGROUPS_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_OPEN_MAX"))
-#ifdef _SC_OPEN_MAX
+#if defined(_SC_OPEN_MAX) || HINT_SC_EXIST
return _SC_OPEN_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_SAVED_IDS"))
-#ifdef _SC_SAVED_IDS
+#if defined(_SC_SAVED_IDS) || HINT_SC_EXIST
return _SC_SAVED_IDS;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_STREAM_MAX"))
-#ifdef _SC_STREAM_MAX
+#if defined(_SC_STREAM_MAX) || HINT_SC_EXIST
return _SC_STREAM_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_TZNAME_MAX"))
-#ifdef _SC_TZNAME_MAX
+#if defined(_SC_TZNAME_MAX) || HINT_SC_EXIST
return _SC_TZNAME_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_VERSION"))
-#ifdef _SC_VERSION
+#if defined(_SC_VERSION) || HINT_SC_EXIST
return _SC_VERSION;
#else
goto not_there;
# Thanks to Bart Schuller <schuller@Lunatech.com>
# See Message-ID: <19971009002636.50729@tanglefoot>
# XXX A Configure test is needed.
-$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ;
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DHINT_SC_EXIST' ;
di
div_amg
div_ass_amg
+do_binmode
ds
eq_amg
exp_amg
filter_add
filter_del
filter_read
+find_script
find_threadsv
fold_constants
force_ident
lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc'
;;
*)
-lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
+lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
;;
esac
# hints file for BSD/OS (adapted from bsd386.sh)
# Original by Neil Bowers <neilb@khoros.unm.edu>; Tue Oct 4 12:01:34 EDT 1994
# Updated by Tony Sanders <sanders@bsdi.com>; Sat Aug 23 12:47:45 MDT 1997
-# Added 3.1 with ELF dynamic libraries
+# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0)
# SYSV IPC tested Ok so I re-enabled.
#
# To override the compiler on the command line:
glibpth="$glibpth /usr/X11/lib"
ldflags="$ldflags -L/usr/X11/lib"
+# Avoid telldir prototype conflict in pp_sys.c
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
case "$optimize" in
'') optimize='-O2' ;;
esac
libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted"
libswanted="rpc curses termcap $libswanted"
;;
+4.0*)
+ # ELF dynamic link libraries starting in 4.0 (???)
+ useshrplib='true'
+ so='so'
+ dlext='so'
+
+ case "$cc" in
+ '') cc='cc' # cc is gcc2 in 4.0
+ cccdlflags="-fPIC"
+ ccdlflags=" " ;;
+ esac
+
+ case "$ld" in
+ '') ld='ld'
+ lddlflags="-shared -x $lddlflags" ;;
+ esac
+ ;;
esac
+
# "ext.libs" file which is *probably* messing up the order. Often,
# you can replace ext.libs with an empty file to fix the problem.
#
-# If you get a message about "too much defining", you might have to
-# add the following to your ccflags: '-Wp,-H256000'
+# If you get a message about "too much defining", as may happen
+# in HPUX < 10, you might have to append a single entry to your
+# ccflags: '-Wp,-H256000'
+# NOTE: This is a single entry (-W takes the argument 'p,-H256000').
#--------------------------------------------------------------------
# Turn on the _HPUX_SOURCE flag to get many of the HP add-ons
esac
;;
esac
+# netbsd 1.3 linker warns about setr[gu]id being deprecated.
+# (setregid, setreuid, preferred?)
+case "$osvers" in
+1.3|1.3*)
+ d_setrgid="$undef"
+ d_setruid="$undef"
+ ;;
+esac
# netbsd had these but they don't really work as advertised, in the
# versions listed below. if they are defined, then there isn't a
startsh="#!$sh"
cc='gcc'
+# Make denser object files and DLL
+case "X$optimize" in
+ X)
+ optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s"
+ ld_dll_optimize="-s"
+ ;;
+esac
+
# Get some standard things (indented to avoid putting in config.sh):
oifs="$IFS"
IFS=" ;"
aout_lib_ext='.a'
aout_ar='ar'
aout_plibext='.a'
-aout_lddlflags='-Zdll'
+aout_lddlflags="-Zdll $ld_dll_optimize"
if [ $emxcrtrev -ge 50 ]; then
- aout_ldflags='-Zexe -Zsmall-conv'
+ aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000'
else
- aout_ldflags='-Zexe'
+ aout_ldflags='-Zexe -Zstack 32000'
fi
# To get into config.sh:
else
d_fork='undef'
fi
- lddlflags='-Zdll -Zomf -Zmt -Zcrtdll'
+ lddlflags="-Zdll -Zomf -Zmt -Zcrtdll $ld_dll_optimize"
# Recursive regmatch may eat 2.5M of stack alone.
ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000'
if [ $emxcrtrev -ge 50 ]; then
d_getprior='define'
d_setprior='define'
-# Make denser object files and DLL
-case "X$optimize" in
- X)
- optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s"
- ;;
-esac
-
if [ "X$usethreads" = "X$define" ]; then
ccflags="-Zmt $ccflags"
cppflags="-Zmt $cppflags" # Do we really need to set this?
# UnixWare has a broken csh. The undocumented -X argument to uname is probably
# a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in
-# FILE* got renamed!
+# FILE* got renamed! Plus 1.1 can't cast large floats to 32-bit ints.
uw_ver=`uname -v`
uw_isuw=`uname -X 2>&1 | grep Release`
+if [ "$uw_isuw" = "Release = 4.2" ]; then
+ case $uw_ver in
+ 1.1)
+ d_casti32='undef'
+ ;;
+ esac
+fi
if [ "$uw_isuw" = "Release = 4.2MP" ]; then
case $uw_ver in
2.1)
Exporter::import('ExtUtils::MakeMaker',
qw( $Verbose &neatvalue));
-$ENV{EMXSHELL} = 'sh'; # to run `commands`
unshift @MM::ISA, 'ExtUtils::MM_OS2';
sub dlsyms {
$ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}
if ($^O eq 'solaris');
+ # The IRIX linker also doesn't use LD_RUN_PATH
+ $ldrun = "-rpath $self->{LD_RUN_PATH}"
+ if ($^O eq 'irix');
+
push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
push @m, '
}
elsif ($fstype !~ /^VMS/i) { # default to Unix
($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
+ if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) {
+ # dev:[000000] is top of VMS tree, similar to Unix '/'
+ ($basename,$dirpath) = ('',$fullname);
+ }
$dirpath = './' unless $dirpath;
}
$paths = [$paths] unless ref $paths;
my(@created,$path);
foreach $path (@$paths) {
+ $path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # feature of CRT
next if -d $path;
# Logic wants Unix paths, so go with the flow.
$path = VMS::Filespec::unixify($path) if $Is_VMS;
my $parent = File::Basename::dirname($path);
- push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+ # Allow for creation of new logical filesystems under VMS
+ if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
+ push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+ }
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
# allow for another process to have created it meanwhile
ENTER;
SAVESPTR(compiling.cop_filegv);
SAVEI16(compiling.cop_line);
- SAVEI32(perldb);
save_svref(&rs);
sv_setsv(rs, nrs);
AOUT_LIBPERL_DLL = libperl_dll$aout_lib_ext
AOUT_CCCMD_DLL = \$(CC) -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK
-AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll
+AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll -Zstack 32000
LD_OPT = $optimize
os2$(OBJ_EXT) : os2.c
os2.c: os2/os2.c os2ish.h
- cp $< $@
+ cp -f $< $@
dl_os2.c: os2/dl_os2.c os2ish.h
- cp $< $@
+ cp -f $< $@
os2ish.h: os2/os2ish.h
- cp $< $@
+ cp -f $< $@
os2thread.h: os2/os2thread.h
- cp $< $@
+ cp -f $< $@
dlfcn.h: os2/dlfcn.h
- cp $< $@
+ cp -f $< $@
# This one is compiled OMF, so cannot fork():
#endif
}
+#define EXECF_SPAWN 0
+#define EXECF_EXEC 1
+#define EXECF_TRUEEXEC 2
+#define EXECF_SPAWN_NOWAIT 3
+
+/* Spawn/exec a program, revert to shell if needed. */
+/* global Argv[] contains arguments. */
+
int
-do_aspawn(really,mark,sp)
+do_aspawn(really, flag, execf)
SV *really;
-register SV **mark;
-register SV **sp;
+U32 flag;
+U32 execf;
{
dTHR;
- 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;
+ int trueflag = flag;
+ int rc, secondtry = 0, err;
+ char *tmps;
+ char buf[256], *s = 0;
+ char *args[4];
+ static char * fargs[4]
+ = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
+ char **argsp = fargs;
+ char nargs = 4;
+
if (flag == P_WAIT)
flag = P_NOWAIT;
- if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path;
+ retry:
+ if (strEQ(Argv[0],"/bin/sh"))
+ Argv[0] = sh_path;
if (Argv[0][0] != '/' && Argv[0][0] != '\\'
&& !(Argv[0][0] && Argv[0][1] == ':'
) /* 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 = result(trueflag, spawnvp(flag,tmps,Argv));
- else
- rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
-
+ if (!really || !*(tmps = SvPV(really, na)))
+ tmps = Argv[0];
+#if 0
+ rc = result(trueflag, spawnvp(flag,tmps,Argv));
+#else
+ if (execf == EXECF_TRUEEXEC)
+ rc = execvp(tmps,Argv);
+ else if (execf == EXECF_EXEC)
+ rc = spawnvp(trueflag | P_OVERLAY,tmps,Argv);
+ else if (execf == EXECF_SPAWN_NOWAIT)
+ rc = spawnvp(trueflag | P_NOWAIT,tmps,Argv);
+ else /* EXECF_SPAWN */
+ rc = result(trueflag,
+ spawnvp(trueflag | P_NOWAIT,tmps,Argv));
+#endif
if (rc < 0 && secondtry == 0
- && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */
+ && (tmps == Argv[0])) { /* Cannot transfer `really' via shell. */
err = errno;
if (err == ENOENT) { /* No such file. */
/* One reason may be that EMX added .exe. We suppose
- that .exe-less files are automatically shellable. */
+ that .exe-less files are automatically shellable.
+ It might have also been .cmd file without
+ extension. */
char *no_dir;
(no_dir = strrchr(Argv[0], '/'))
|| (no_dir = strrchr(Argv[0], '\\'))
if (stat(Argv[0], &buffer) != -1) { /* File exists. */
/* Maybe we need to specify the full name here? */
goto doshell;
+ } else {
+ /* Try adding script extensions to the file name */
+ char *scr;
+ if ((scr = find_script(Argv[0], TRUE, NULL, 0))) {
+ FILE *file = fopen(scr, "r");
+ char *s = 0, *s1;
+
+ Argv[0] = scr;
+ if (!file)
+ goto panic_file;
+ if (!fgets(buf, sizeof buf, file)) {
+ fclose(file);
+ goto panic_file;
+ }
+ if (fclose(file) != 0) { /* Failure */
+ panic_file:
+ warn("Error reading \"%s\": %s",
+ scr, Strerror(errno));
+ goto doshell;
+ }
+ if (buf[0] == '#') {
+ if (buf[1] == '!')
+ s = buf + 2;
+ } else if (buf[0] == 'e') {
+ if (strnEQ(buf, "extproc", 7)
+ && isSPACE(buf[7]))
+ s = buf + 8;
+ } else if (buf[0] == 'E') {
+ if (strnEQ(buf, "EXTPROC", 7)
+ && isSPACE(buf[7]))
+ s = buf + 8;
+ }
+ if (!s)
+ goto doshell;
+ s1 = s;
+ nargs = 0;
+ argsp = args;
+ while (1) {
+ while (isSPACE(*s))
+ s++;
+ if (*s == 0)
+ break;
+ if (nargs == 4) {
+ nargs = -1;
+ break;
+ }
+ args[nargs++] = s;
+ while (*s && !isSPACE(*s))
+ s++;
+ if (*s == 0)
+ break;
+ *s++ = 0;
+ }
+ if (nargs == -1) {
+ warn("Too many args on %.*s line of \"%s\"",
+ s1 - buf, buf, scr);
+ nargs = 4;
+ argsp = fargs;
+ }
+ goto doshell;
+ }
}
}
+ /* Restore errno */
+ errno = err;
} else if (err == ENOEXEC) { /* Need to send to shell. */
doshell:
+ {
+ char **a = Argv;
+
+ while (a[1]) /* Get to the end */
+ a++;
while (a >= Argv) {
- *(a + 2) = *a;
+ *(a + nargs) = *a; /* Argv was preallocated to be
+ long enough. */
a--;
}
- *Argv = sh_path;
- *(Argv + 1) = "-c";
+ while (nargs-- >= 0)
+ Argv[nargs] = argsp[nargs];
secondtry = 1;
goto retry;
+ }
}
}
if (rc < 0 && dowarn)
- warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
- if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ warn("Can't %s \"%s\": %s\n",
+ ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
+ ? "spawn" : "exec"),
+ Argv[0], Strerror(err));
+ if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
+ && ((trueflag & 0xFF) == P_WAIT))
+ rc = 255 << 8; /* Emulate the fork(). */
+
+ return rc;
+}
+
+int
+do_aspawn(really,mark,sp)
+SV *really;
+register SV **mark;
+register SV **sp;
+{
+ dTHR;
+ 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;
+
+ rc = do_spawn_ve(really, flag, EXECF_SPAWN);
} else
rc = -1;
do_execfree();
return rc;
}
-#define EXECF_SPAWN 0
-#define EXECF_EXEC 1
-#define EXECF_TRUEEXEC 2
-#define EXECF_SPAWN_NOWAIT 3
-
+/* Try converting 1-arg form to (usually shell-less) multi-arg form. */
int
do_spawn2(cmd, execf)
char *cmd;
} else if (*s == '\\' && !seenspace) {
continue; /* Allow backslashes in names */
}
+ /* We do not convert this to do_spawn_ve since shell
+ should be smart enough to start itself gloriously. */
doshell:
if (execf == EXECF_TRUEEXEC)
return execl(shell,shell,copt,cmd,(char*)0);
}
}
- New(1303,Argv, (s - cmd) / 2 + 2, char*);
+ /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */
+ New(1303,Argv, (s - cmd + 11) / 2, char*);
Cmd = savepvn(cmd, s-cmd);
a = Argv;
for (s = Cmd; *s;) {
*s++ = '\0';
}
*a = Nullch;
- if (Argv[0]) {
- int err;
-
- if (execf == EXECF_TRUEEXEC)
- rc = execvp(Argv[0],Argv);
- else if (execf == EXECF_EXEC)
- rc = spawnvp(P_OVERLAY,Argv[0],Argv);
- else if (execf == EXECF_SPAWN_NOWAIT)
- rc = spawnvp(P_NOWAIT,Argv[0],Argv);
- else
- rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
- if (rc < 0) {
- err = errno;
- if (err == ENOENT) { /* No such file. */
- /* One reason may be that EMX added .exe. We suppose
- that .exe-less files are automatically shellable. */
- 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",
- ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
- ? "spawn" : "exec"),
- Argv[0], Strerror(err));
- if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
- } else
+ if (Argv[0])
+ rc = do_spawn_ve(NULL, 0, execf);
+ else
rc = -1;
if (news) Safefree(news);
do_execfree();
dup2(newfd, *mode == 'r'); /* Return std* back. */
close(newfd);
}
- close(p[that]);
+ if (p[that] == (*mode == 'r'))
+ close(p[that]);
if (pid == -1) {
close(p[this]);
return NULL;
$base =~ s|.*/||;
$file =~ s|/|\\|g ;
print "Processing $file => $dir\\$base.cmd\n";
- system 'cmd.exe', '/c', "echo extproc perl -S >$dir\\$base.cmd";
+ system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd";
system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd";
}
&& (DBcv || (DBcv = GvCV(DBsub)))
/* Try harder, since this may have been a sighandler, thus
* curstash may be meaningless. */
- && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != debstash))
+ && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != debstash)
+ && !(flags & G_NODEBUG))
op->op_private |= OPpENTERSUB_DB;
if (flags & G_EVAL) {
open_script(char *scriptname, bool dosearch, SV *sv)
{
dTHR;
- char *xfound = Nullch;
- char *xfailed = Nullch;
register char *s;
- I32 len;
- int retval;
-#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
-# define SEARCH_EXTS ".bat", ".cmd", NULL
-# define MAX_EXT_LEN 4
-#endif
-#ifdef OS2
-# define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL
-# define MAX_EXT_LEN 4
-#endif
-#ifdef VMS
-# define SEARCH_EXTS ".pl", ".com", NULL
-# define MAX_EXT_LEN 4
-#endif
- /* additional extensions to try in each dir if scriptname not found */
-#ifdef SEARCH_EXTS
- char *ext[] = { SEARCH_EXTS };
- int extidx = 0, i = 0;
- char *curext = Nullch;
-#else
-# define MAX_EXT_LEN 0
-#endif
-
- /*
- * If dosearch is true and if scriptname does not contain path
- * delimiters, search the PATH for scriptname.
- *
- * If SEARCH_EXTS is also defined, will look for each
- * scriptname{SEARCH_EXTS} whenever scriptname is not found
- * while searching the PATH.
- *
- * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
- * proceeds as follows:
- * If DOSISH or VMSISH:
- * + look for ./scriptname{,.foo,.bar}
- * + search the PATH for scriptname{,.foo,.bar}
- *
- * If !DOSISH:
- * + look *only* in the PATH for scriptname{,.foo,.bar} (note
- * this will not look in '.' if it's not in the PATH)
- */
-
-#ifdef VMS
-# ifdef ALWAYS_DEFTYPES
- len = strlen(scriptname);
- if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
- int hasdir, idx = 0, deftypes = 1;
- bool seen_dot = 1;
-
- hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
-# else
- if (dosearch) {
- int hasdir, idx = 0, deftypes = 1;
- bool seen_dot = 1;
-
- hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
-# endif
- /* The first time through, just add SEARCH_EXTS to whatever we
- * already have, so we can check for default file types. */
- while (deftypes ||
- (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
- {
- if (deftypes) {
- deftypes = 0;
- *tokenbuf = '\0';
- }
- if ((strlen(tokenbuf) + strlen(scriptname)
- + MAX_EXT_LEN) >= sizeof tokenbuf)
- continue; /* don't search dir with too-long name */
- strcat(tokenbuf, scriptname);
-#else /* !VMS */
-
-#ifdef DOSISH
- if (strEQ(scriptname, "-"))
- dosearch = 0;
- if (dosearch) { /* Look in '.' first. */
- char *cur = scriptname;
-#ifdef SEARCH_EXTS
- if ((curext = strrchr(scriptname,'.'))) /* possible current ext */
- while (ext[i])
- if (strEQ(ext[i++],curext)) {
- extidx = -1; /* already has an ext */
- break;
- }
- do {
-#endif
- DEBUG_p(PerlIO_printf(Perl_debug_log,
- "Looking for %s\n",cur));
- if (PerlLIO_stat(cur,&statbuf) >= 0) {
- dosearch = 0;
- scriptname = cur;
-#ifdef SEARCH_EXTS
- break;
-#endif
- }
-#ifdef SEARCH_EXTS
- if (cur == scriptname) {
- len = strlen(scriptname);
- if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
- break;
- cur = strcpy(tokenbuf, scriptname);
- }
- } while (extidx >= 0 && ext[extidx] /* try an extension? */
- && strcpy(tokenbuf+len, ext[extidx++]));
-#endif
- }
-#endif
- if (dosearch && !strchr(scriptname, '/')
-#ifdef DOSISH
- && !strchr(scriptname, '\\')
-#endif
- && (s = PerlEnv_getenv("PATH"))) {
- bool seen_dot = 0;
-
- bufend = s + strlen(s);
- while (s < bufend) {
-#if defined(atarist) || defined(DOSISH)
- for (len = 0; *s
-# ifdef atarist
- && *s != ','
-# endif
- && *s != ';'; len++, s++) {
- if (len < sizeof tokenbuf)
- tokenbuf[len] = *s;
- }
- if (len < sizeof tokenbuf)
- tokenbuf[len] = '\0';
-#else /* ! (atarist || DOSISH) */
- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
- ':',
- &len);
-#endif /* ! (atarist || DOSISH) */
- if (s < bufend)
- s++;
- if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
- continue; /* don't search dir with too-long name */
- if (len
-#if defined(atarist) || defined(DOSISH)
- && tokenbuf[len - 1] != '/'
- && tokenbuf[len - 1] != '\\'
-#endif
- )
- tokenbuf[len++] = '/';
- if (len == 2 && tokenbuf[0] == '.')
- seen_dot = 1;
- (void)strcpy(tokenbuf + len, scriptname);
-#endif /* !VMS */
-
-#ifdef SEARCH_EXTS
- len = strlen(tokenbuf);
- if (extidx > 0) /* reset after previous loop */
- extidx = 0;
- do {
-#endif
- DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
- retval = PerlLIO_stat(tokenbuf,&statbuf);
-#ifdef SEARCH_EXTS
- } while ( retval < 0 /* not there */
- && extidx>=0 && ext[extidx] /* try an extension? */
- && strcpy(tokenbuf+len, ext[extidx++])
- );
-#endif
- if (retval < 0)
- continue;
- if (S_ISREG(statbuf.st_mode)
- && cando(S_IRUSR,TRUE,&statbuf)
-#ifndef DOSISH
- && cando(S_IXUSR,TRUE,&statbuf)
-#endif
- )
- {
- xfound = tokenbuf; /* bingo! */
- break;
- }
- if (!xfailed)
- xfailed = savepv(tokenbuf);
- }
-#ifndef DOSISH
- if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
-#endif
- seen_dot = 1; /* Disable message. */
- if (!xfound)
- croak("Can't %s %s%s%s",
- (xfailed ? "execute" : "find"),
- (xfailed ? xfailed : scriptname),
- (xfailed ? "" : " on PATH"),
- (xfailed || seen_dot) ? "" : ", '.' not in PATH");
- if (xfailed)
- Safefree(xfailed);
- scriptname = xfound;
- }
+ scriptname = find_script(scriptname, dosearch, NULL, 0);
if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
char *s = scriptname + 8;
#endif /* OVERLOAD */
-#define PERLDB_ALL 0xff
+#define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */
#define PERLDBf_LINE 0x02 /* Keep line #. */
#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */
later inspections. */
#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */
#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */
+#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr. */
+#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto. */
#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB))
#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE))
#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER))
#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE))
#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE))
+#define PERLDB_SUB_NN (perldb && (perldb & (PERLDBf_NONAME)))
+#define PERLDB_GOTO (perldb && (perldb & PERLDBf_GOTO))
#ifdef USE_LOCALE_NUMERIC
Sets up the C<ix> variable for an XSUB which has aliases. This is usually
handled automatically by C<xsubpp>.
+=item do_binmode
+
+Switches filehandle to binmode. C<iotype> is what C<IoTYPE(io)> would
+contain.
+
+ do_binmode(fp, iotype, TRUE);
+
=item ENTER
Opening bracket on a callback. See C<LEAVE> and L<perlcall>.
# 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' && $^O ne 'dos') {
+if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
($version,$patch) =
`\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
}
mark++;
}
}
- if (PERLDB_SUB && curstash != debstash) {
+ if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
/*
* We do not care about using sv to call CV;
* it's for informational purposes only.
*/
SV *sv = GvSV(DBsub);
- save_item(sv);
- gv_efullname3(sv, CvGV(cv), Nullch);
+ CV *gotocv;
+
+ if (PERLDB_SUB_NN) {
+ SvIVX(sv) = (IV)cv; /* Already upgraded, saved */
+ } else {
+ save_item(sv);
+ gv_efullname3(sv, CvGV(cv), Nullch);
+ }
+ if ( PERLDB_GOTO
+ && (gotocv = perl_get_cv("DB::goto", FALSE)) ) {
+ PUSHMARK( stack_sp );
+ perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+ stack_sp--;
+ }
}
RETURNOP(CvSTART(cv));
}
get_db_sub(SV **svp, CV *cv)
{
dTHR;
- SV *oldsv = *svp;
- GV *gv;
+ SV *dbsv = GvSV(DBsub);
+
+ if (!PERLDB_SUB_NN) {
+ GV *gv = CvGV(cv);
- *svp = GvSV(DBsub);
- save_item(*svp);
- gv = CvGV(cv);
- if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
- || strEQ(GvNAME(gv), "END")
- || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
- !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
- && (gv = (GV*)oldsv) ))) {
- /* Use GV from the stack as a fallback. */
- /* GV is potentially non-unique, or contain different CV. */
- sv_setsv(*svp, newRV((SV*)cv));
+ save_item(dbsv);
+ if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+ || strEQ(GvNAME(gv), "END")
+ || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+ !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
+ && (gv = (GV*)*svp) ))) {
+ /* Use GV from the stack as a fallback. */
+ /* GV is potentially non-unique, or contain different CV. */
+ sv_setsv(dbsv, newRV((SV*)cv));
+ }
+ else {
+ gv_efullname3(dbsv, gv, Nullch);
+ }
}
else {
- gv_efullname3(*svp, gv, Nullch);
+ SvUPGRADE(dbsv, SVt_PVIV);
+ SvIOK_on(dbsv);
+ SAVEIV(SvIVX(dbsv));
+ SvIVX(dbsv) = (IV)cv; /* Do it the quickest way */
}
- cv = GvCV(DBsub);
+
if (CvXSUB(cv))
curcopdb = curcop;
+ cv = GvCV(DBsub);
return cv;
}
if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
RETPUSHUNDEF;
-#ifdef DOSISH
-#ifdef atarist
- if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
+ if (do_binmode(fp,IoTYPE(io),TRUE))
RETPUSHYES;
else
RETPUSHUNDEF;
-#else
- if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
-#if defined(WIN32) && defined(__BORLANDC__)
- /* The translation mode of the stream is maintained independent
- * of the translation mode of the fd in the Borland RTL (heavy
- * digging through their runtime sources reveal). User has to
- * set the mode explicitly for the stream (though they don't
- * document this anywhere). GSAR 97-5-24
- */
- PerlIO_seek(fp,0L,0);
- fp->flags |= _F_BIN;
-#endif
- RETPUSHYES;
- }
- else
- RETPUSHUNDEF;
-#endif
-#else
-#if defined(USEMYBINMODE)
- if (my_binmode(fp,IoTYPE(io)) != NULL)
- RETPUSHYES;
- else
- RETPUSHUNDEF;
-#else
- RETPUSHYES;
-#endif
-#endif
-
}
if (svp)
tmps = SvPV(*svp, na);
}
+#ifdef VMS
+ if (!tmps || !*tmps) {
+ svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
+ if (svp)
+ tmps = SvPV(*svp, na);
+ }
+#endif
TAINT_PROPER("chdir");
PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS
OP* die_where _((char* message));
void dounwind _((I32 cxix));
bool do_aexec _((SV* really, SV** mark, SV** sp));
+int do_binmode _((PerlIO *fp, int iotype, int flag));
void do_chop _((SV* asv, SV* sv));
bool do_close _((GV* gv, bool not_implicit));
bool do_eof _((GV* gv));
void dump_sub _((GV* gv));
void fbm_compile _((SV* sv, U32 flags));
char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv));
+char* find_script _((char *scriptname, bool dosearch, char **search_ext, I32 flags));
#ifdef USE_THREADS
PADOFFSET find_threadsv _((char *name));
#endif
print "not " unless $foo eq "ok 3\n";
print "ok 2\n";
+binmode STDOUT; # Copy::copy works in binary mode
copy "copy-$$", \*STDOUT;
unlink "copy-$$" or die "unlink: $!";
VTOH(vtohl,long)
#endif
+int
+do_binmode(PerlIO *fp, int iotype, int flag)
+{
+ if (flag != TRUE)
+ croak("panic: unsetting binmode"); /* Not implemented yet */
+#ifdef DOSISH
+#ifdef atarist
+ if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
+ return 1;
+ else
+ return 0;
+#else
+ if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
+#if defined(WIN32) && defined(__BORLANDC__)
+ /* The translation mode of the stream is maintained independent
+ * of the translation mode of the fd in the Borland RTL (heavy
+ * digging through their runtime sources reveal). User has to
+ * set the mode explicitly for the stream (though they don't
+ * document this anywhere). GSAR 97-5-24
+ */
+ PerlIO_seek(fp,0L,0);
+ fp->flags |= _F_BIN;
+#endif
+ return 1;
+ }
+ else
+ return 0;
+#endif
+#else
+#if defined(USEMYBINMODE)
+ if (my_binmode(fp,iotype) != NULL)
+ return 1;
+ else
+ return 0;
+#else
+ return 1;
+#endif
+#endif
+}
+
/* VMS' my_popen() is in VMS.c, same with OS/2. */
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS)
PerlIO *
return retval;
}
+char*
+find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
+{
+ dTHR;
+ char *xfound = Nullch;
+ char *xfailed = Nullch;
+ register char *s;
+ I32 len;
+ int retval;
+#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
+# define SEARCH_EXTS ".bat", ".cmd", NULL
+# define MAX_EXT_LEN 4
+#endif
+#ifdef OS2
+# define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL
+# define MAX_EXT_LEN 4
+#endif
+#ifdef VMS
+# define SEARCH_EXTS ".pl", ".com", NULL
+# define MAX_EXT_LEN 4
+#endif
+ /* additional extensions to try in each dir if scriptname not found */
+#ifdef SEARCH_EXTS
+ char *exts[] = { SEARCH_EXTS };
+ char **ext = search_ext ? search_ext : exts;
+ int extidx = 0, i = 0;
+ char *curext = Nullch;
+#else
+# define MAX_EXT_LEN 0
+#endif
+
+ /*
+ * If dosearch is true and if scriptname does not contain path
+ * delimiters, search the PATH for scriptname.
+ *
+ * If SEARCH_EXTS is also defined, will look for each
+ * scriptname{SEARCH_EXTS} whenever scriptname is not found
+ * while searching the PATH.
+ *
+ * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
+ * proceeds as follows:
+ * If DOSISH or VMSISH:
+ * + look for ./scriptname{,.foo,.bar}
+ * + search the PATH for scriptname{,.foo,.bar}
+ *
+ * If !DOSISH:
+ * + look *only* in the PATH for scriptname{,.foo,.bar} (note
+ * this will not look in '.' if it's not in the PATH)
+ */
+
+#ifdef VMS
+# ifdef ALWAYS_DEFTYPES
+ len = strlen(scriptname);
+ if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
+ int hasdir, idx = 0, deftypes = 1;
+ bool seen_dot = 1;
+
+ hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+# else
+ if (dosearch) {
+ int hasdir, idx = 0, deftypes = 1;
+ bool seen_dot = 1;
+
+ hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+# endif
+ /* The first time through, just add SEARCH_EXTS to whatever we
+ * already have, so we can check for default file types. */
+ while (deftypes ||
+ (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
+ {
+ if (deftypes) {
+ deftypes = 0;
+ *tokenbuf = '\0';
+ }
+ if ((strlen(tokenbuf) + strlen(scriptname)
+ + MAX_EXT_LEN) >= sizeof tokenbuf)
+ continue; /* don't search dir with too-long name */
+ strcat(tokenbuf, scriptname);
+#else /* !VMS */
+
+#ifdef DOSISH
+ if (strEQ(scriptname, "-"))
+ dosearch = 0;
+ if (dosearch) { /* Look in '.' first. */
+ char *cur = scriptname;
+#ifdef SEARCH_EXTS
+ if ((curext = strrchr(scriptname,'.'))) /* possible current ext */
+ while (ext[i])
+ if (strEQ(ext[i++],curext)) {
+ extidx = -1; /* already has an ext */
+ break;
+ }
+ do {
+#endif
+ DEBUG_p(PerlIO_printf(Perl_debug_log,
+ "Looking for %s\n",cur));
+ if (PerlLIO_stat(cur,&statbuf) >= 0) {
+ dosearch = 0;
+ scriptname = cur;
+#ifdef SEARCH_EXTS
+ break;
+#endif
+ }
+#ifdef SEARCH_EXTS
+ if (cur == scriptname) {
+ len = strlen(scriptname);
+ if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
+ break;
+ cur = strcpy(tokenbuf, scriptname);
+ }
+ } while (extidx >= 0 && ext[extidx] /* try an extension? */
+ && strcpy(tokenbuf+len, ext[extidx++]));
+#endif
+ }
+#endif
+
+ if (dosearch && !strchr(scriptname, '/')
+#ifdef DOSISH
+ && !strchr(scriptname, '\\')
+#endif
+ && (s = PerlEnv_getenv("PATH"))) {
+ bool seen_dot = 0;
+
+ bufend = s + strlen(s);
+ while (s < bufend) {
+#if defined(atarist) || defined(DOSISH)
+ for (len = 0; *s
+# ifdef atarist
+ && *s != ','
+# endif
+ && *s != ';'; len++, s++) {
+ if (len < sizeof tokenbuf)
+ tokenbuf[len] = *s;
+ }
+ if (len < sizeof tokenbuf)
+ tokenbuf[len] = '\0';
+#else /* ! (atarist || DOSISH) */
+ s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
+ ':',
+ &len);
+#endif /* ! (atarist || DOSISH) */
+ if (s < bufend)
+ s++;
+ if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
+ continue; /* don't search dir with too-long name */
+ if (len
+#if defined(atarist) || defined(DOSISH)
+ && tokenbuf[len - 1] != '/'
+ && tokenbuf[len - 1] != '\\'
+#endif
+ )
+ tokenbuf[len++] = '/';
+ if (len == 2 && tokenbuf[0] == '.')
+ seen_dot = 1;
+ (void)strcpy(tokenbuf + len, scriptname);
+#endif /* !VMS */
+
+#ifdef SEARCH_EXTS
+ len = strlen(tokenbuf);
+ if (extidx > 0) /* reset after previous loop */
+ extidx = 0;
+ do {
+#endif
+ DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
+ retval = PerlLIO_stat(tokenbuf,&statbuf);
+#ifdef SEARCH_EXTS
+ } while ( retval < 0 /* not there */
+ && extidx>=0 && ext[extidx] /* try an extension? */
+ && strcpy(tokenbuf+len, ext[extidx++])
+ );
+#endif
+ if (retval < 0)
+ continue;
+ if (S_ISREG(statbuf.st_mode)
+ && cando(S_IRUSR,TRUE,&statbuf)
+#ifndef DOSISH
+ && cando(S_IXUSR,TRUE,&statbuf)
+#endif
+ )
+ {
+ xfound = tokenbuf; /* bingo! */
+ break;
+ }
+ if (!xfailed)
+ xfailed = savepv(tokenbuf);
+ }
+#ifndef DOSISH
+ if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
+#endif
+ seen_dot = 1; /* Disable message. */
+ if (!xfound)
+ scriptname = NULL;
+/* croak("Can't %s %s%s%s",
+ (xfailed ? "execute" : "find"),
+ (xfailed ? xfailed : scriptname),
+ (xfailed ? "" : " on PATH"),
+ (xfailed || seen_dot) ? "" : ", '.' not in PATH"); */
+ if (xfailed)
+ Safefree(xfailed);
+ scriptname = xfound;
+ }
+ return scriptname;
+}
+
+
#ifdef USE_THREADS
#ifdef FAKE_THREADS
/* Very simplistic scheduler for now */
if ($^O eq 'os2') {
require POSIX;
$tmp = POSIX::tmpnam();
+ unshift @pagers, 'less', 'cmd /c more <';
} else {
$tmp = "/tmp/perldoc1.$$";
}
* have select(), of course.
*/
#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) && defined(DECCRTL_SOCKETS)
-#define Select_fd_set_t fd_set * /**/
+#define Select_fd_set_t fd_set * /* config-skip */
#else
#define Select_fd_set_t int * /* config-skip */
#endif
[.lib]perlbug.com : [.utils]perlbug.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
- Rename/Log [.utils]perlbug.com $(MMS$TARGET)
+ Copy/Log [.utils]perlbug.com $(MMS$TARGET)
[.utils]pl2pm.com : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
[.lib]splain.com : [.utils]splain.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
- Rename/Log [.utils]splain.com $(MMS$TARGET)
+ Copy/Log [.utils]splain.com $(MMS$TARGET)
[.x2p]find2perl.com : [.x2p]find2perl.PL $(ARCHDIR)Config.pm
$(MINIPERL) $(MMS$SOURCE)
[.lib.pod]pod2html.com : [.pod]pod2html.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
- Rename/Log [.pod]pod2html.com $(MMS$TARGET)
+ Copy/Log [.pod]pod2html.com $(MMS$TARGET)
[.lib.pod]pod2latex.com : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
- Rename/Log [.pod]pod2latex.com $(MMS$TARGET)
+ Copy/Log [.pod]pod2latex.com $(MMS$TARGET)
[.lib.pod]pod2man.com : [.pod]pod2man.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
- Rename/Log [.pod]pod2man.com $(MMS$TARGET)
+ Copy/Log [.pod]pod2man.com $(MMS$TARGET)
[.lib.pod]pod2text.com : [.pod]pod2text.PL $(ARCHDIR)Config.pm
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
$(MINIPERL) $(MMS$SOURCE)
- Rename/Log [.pod]pod2text.com $(MMS$TARGET)
+ Copy/Log [.pod]pod2text.com $(MMS$TARGET)
preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM)
@ Write Sys$Output "Autosplitting Perl library . . ."
test : all [.t.lib]vmsfspec.t [.t.lib]vmsish.t
- @[.VMS]Test.Com "$(E)"
+install :
+ $(MINIPERL) installperl
+
archify : all
@ Write Sys$Output "Moving files to architecture-specific locations for $(ARCH)"
archroot = "$(ARCHAUTO)" - "]" + "...]"
- If F$Search("Perlshr_Gbl*.Mar;-1") .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar
- If F$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O)
- If F$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C
+ - If F$Search("[.Ext.Socket]Socket.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C
- If F$Search("[.Ext.Opcode...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Opcode]
- If F$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C
- If F$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O)
- If F$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod
- If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.*
- If F$Search("[.lib]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib]*.com
+ - If F$Search("[.pod]*.com;-1").nes."" Then Purge/NoConfirm/Log [.pod]*.com
- If F$Search("[.utils]*.com;-1").nes."" Then Purge/NoConfirm/Log [.utils]*.com
- If F$Search("[.x2p]*.com;-1").nes."" Then Purge/NoConfirm/Log [.x2p]*.com
- If F$Search("[.lib.pod]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*.com
- If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;*
- If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;*
- If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);*
+ - If F$Search("[.pod]*.com").nes."" Then Delete/NoConfirm/Log [.pod]*.com;*
realclean : clean
Set Default [.ext.Fcntl]
my($path) = @_;
if (!$path) { return undef }
+ if ($path eq '/') { return 'sys$disk:[000000]'; }
if ($path =~ /(.+)\.([^:>\]]*)$/) {
$path = $1;
if ($2 !~ /^dir(?:;1)?$/i) { return undef }
.. vmsify [-]
../.. vmsify [--]
.../ vmsify [...]
+/ vmsify sys$disk:[000000]
# Fileifying directory specs
down:[the.garden.path] fileify down:[the.garden]path.dir;1
[.down.the.garden]path.dir unixpath down/the/garden/path/
down/the/garden/path vmspath [.down.the.garden.path]
path vmspath [.path]
+/ vmspath sys$disk:[000000]
# Redundant characters in Unix paths
//some/where//over/../the.rainbow vmsify some:[where]the.rainbow
$ EndIf
$ Set Message /Facility/Severity/Identification/Text
$
-$ exe = ".Exe"
-$ If p1.nes."" Then exe = p1
+$ exe = ".Exe"
+$ If p1.nes."" Then exe = p1
+$ If F$Extract(0,1,exe) .nes. "."
+$ Then
+$ Write Sys$Error ""
+$ Write Sys$Error "The first parameter passed to Test.Com must be the file type used for the"
+$ Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited"
+$ Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line."
+$ Write Sys$Error ""
+$ Exit 44
+$ EndIf
$! Pick up a copy of perl to use for the tests
$ Delete/Log/NoConfirm Perl.;*
$ Copy/Log/NoConfirm [-]Perl'exe' []Perl.
# insists on stat()ing a file descriptor before it'll use it.
push(@libexcl,'io_xs.t') if $Config{'vms_cc_type'} ne 'decc';
-@opexcl=('exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t');
+@opexcl=('die_exit.t','exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t');
@exclist=(@compexcl,@ioexcl,@libexcl,@opexcl);
foreach $file (@exclist) { $skip{$file}++; }
projects / p5sagit/p5-mst-13.2.git / commitdiff