" dynamic loading or has the $module module statically linked into it.)\n")
unless defined(&dl_load_file);
+EOT
+
+print OUT <<'EOT' if $^O eq 'os2';
+ # Can dynaload, but cannot dynaload Perl modules...
+ die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static;
+
+EOT
+
+print OUT <<'EOT';
my @modparts = split(/::/,$module);
my $modfname = $modparts[-1];
dlsym
dlerror
dlclose
+ dup2
+ dup
my_tmpfile
my_tmpnam
my_flock
}
if ($PLATFORM eq 'os2') {
- print "; LAST_ORDINAL=$sym_ord\n";
+ print <<EOP;
+ dll_perlmain=main
+; LAST_ORDINAL=$sym_ord
+EOP
}
sub emit_symbol {
SO_CCCMD = \$(CC) $ccflags \$(OPTIMIZE)
LD_OPT = \$(OPTIMIZE)
-PERL_DLL_LD_OPT = -Zmap -Zlinker /map
+PERL_DLL_LD_OPT = -Zmap -Zlinker /map/li
PERL_DLL_BASE = perl$dll_post
PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX)
$spitshell >>Makefile <<'!NO!SUBS!'
PREPLIBRARY_LIBPERL = $(LIBPERL)
-$(LIBPERL): perl.imp $(PERL_DLL) perl5.def libperl_override.lib
+$(LIBPERL): perl.imp perl5.def libperl_override.lib
emximp -o $(LIBPERL) perl.imp
cp $(LIBPERL) perl.lib
-libperl_override.imp: os2/os2add.sym miniperl
+imp_version: $(FIRSTMAKEFILE)
+ echo $(PERL_DLL_BASE) > imp_version.tmp
+ sh mv-if-diff imp_version.tmp $@
+
+libperl_override.imp: os2/os2add.sym miniperl imp_version
./miniperl -wnle 'print "$$_\t$(PERL_DLL_BASE)\t$$_\t?"' os2/os2add.sym > tmp.imp
echo 'strdup $(PERL_DLL_BASE) Perl_strdup ?' >> tmp.imp
echo 'putenv $(PERL_DLL_BASE) Perl_putenv ?' >> tmp.imp
libperl_override.lib: libperl_override.imp
emximp -o $@ libperl_override.imp
+libperl_dllmain.imp: imp_version
+ echo 'main $(PERL_DLL_BASE) dll_perlmain ?' >> tmpdll.imp
+ sh mv-if-diff tmpdll.imp $@
+
+libperl_dllmain.lib: libperl_dllmain.imp
+ emximp -o $@ libperl_dllmain.imp
+
+libperl_dllmain.a: libperl_dllmain.imp
+ emximp -o $@ libperl_dllmain.imp
+
$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
emximp -o $(AOUT_LIBPERL_DLL) perl.imp
-perl.imp: perl5.def
+perl.imp: perl5.def imp_version
emximp -o perl.imp perl5.def
echo 'emx_calloc emxlibcm 400 ?' >> $@
echo 'emx_free emxlibcm 401 ?' >> $@
perlrexx test_prep_perl_ test_prep_perl_sys test_prep_perl_stat \
test_prep_perl_stat_aout test_prep_various \
stat_aout_harness aout_harness stat_harness sys_harness all_harness \
- stat_aout_test aout_test stat_test sys_test all_test
+ stat_aout_test aout_test stat_test sys_test all_test \
+ perl___harness test_harness_redir
perl_dll: $(PERL_DLL)
t/$(PERL_DLL): $(PERL_DLL)
$(LNS) $(PERL_DLL) t/$(PERL_DLL)
-$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
- $(LD) $(LD_OPT) $(LDDLFLAGS) $(PERL_DLL_LD_OPT) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def || ( rm $(PERL_DLL) && sh -c false )
+$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT) perlmain$(OBJ_EXT) $(DYNALOADER)
+ $(LD) $(LD_OPT) $(LDDLFLAGS) $(PERL_DLL_LD_OPT) -o $@ perl$(OBJ_EXT) $(obj) perlmain$(OBJ_EXT) $(DYNALOADER) $(libs) perl5.def || ( rm $(PERL_DLL) && sh -c false )
perl5.olddef: perl.linkexp
echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@
cp -f $< $@
# Non-Forking dynamically loaded perl
+# Make many: they are useful in low-memory conditions (floppy boot? Lot of shared memory used?)
-perl___$(EXE_EXT) perl___: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl___ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /map/PM:VIO
+perl___$(EXE_EXT) perl___: $& libperl_dllmain$(LIB_EXT)
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl___ libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 8192 -o perl___8 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 4096 -o perl___4 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 2048 -o perl___2 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 1024 -o perl___1 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 512 -o perl___05 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+ $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 320 -o perl___03 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
# This one is compiled -Zsys, so cannot do many things:
# Non-forking dynamically loaded perl with a wrong CRT library:
-perl_stat: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(CC) $(STAT_CLDFLAGS) $(CCDLFLAGS) -o $@ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /map/PM:VIO
+perl_stat perl_stat$(EXE_EXT): $& libperl_dllmain$(LIB_EXT)
+ $(SHRPENV) $(CC) $(STAT_CLDFLAGS) $(CCDLFLAGS) -o perl_stat libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
# Remove -Zcrtdll, add -Zsys
SYS_CLDFLAGS = $(STAT_CLDFLAGS) -Zsys
# Non-Forking dynamically loaded perl without EMX - so with wrong CRT library
-perl_sys: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(CC) $(SYS_CLDFLAGS) $(CCDLFLAGS) -o $@ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /map/PM:VIO
+perl_sys perl_sys$(EXE_EXT): $& libperl_dllmain$(LIB_EXT)
+ $(SHRPENV) $(CC) $(SYS_CLDFLAGS) $(CCDLFLAGS) -o perl_sys libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
installcmd :
@perl -e 'die qq{Give the option INSTALLCMDDIR=... to make!} if $$ARGV[0] eq ""' $(INSTALLCMDDIR)
$(AOUT_LIBPERL) : $(aout_obj) perl$(AOUT_OBJ_EXT)
rm -f $@
$(AOUT_AR) rcu $@ perl$(AOUT_OBJ_EXT) $(aout_obj)
- cp $@ perl.a
+ cp $@ perl$(AOUT_LIB_EXT)
.c$(AOUT_OBJ_EXT):
$(AOUT_CCCMD) $(PLDLFLAGS) -c $*.c
perlmain(AOUT_OBJ_EXT): perlmain.c
$(AOUT_CCCMD_DLL) $(PLDLFLAGS) -c perlmain.c
-aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit)
- sh writemain $(DYNALOADER) $(aout_static_lib) > tmp
- sh mv-if-diff tmp aout_perlmain.c
+# Assume that extensions are at most 4 deep (this is so with 5.8.1)
+aout_extlist: $(aout_static_ext)
+ echo lib/auto/*.a lib/auto/*/*.a lib/auto/*/*/*.a lib/auto/*/*/*/*.a | tr ' ' '\n' | grep -v '\*' > $@.tmp
+ sh mv-if-diff $@.tmp $@
+
+aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit) $(aout_static_ext) writemain aout_extlist
+ sh writemain `cat aout_extlist` > aout_perlmain.tmp
+ sh mv-if-diff aout_perlmain.tmp aout_perlmain.c
_preplibrary = miniperl lib/Config.pm lib/lib.pm lib/re.pm
# Need a miniperl_ dependency, since $(AOUT_DYNALOADER) is build via implicit
# rules, thus would not rebuild miniperl_ via an explicit rule
-perl_$(EXE_EXT) perl_: $& miniperl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
- $(CC) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
+perl_$(EXE_EXT) perl_: $& miniperl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs aout_extlist
+ $(CC) $(AOUT_CLDFLAGS) $(CCDLFLAGS) $(OPTIMIZE) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) `cat aout_extlist` $(AOUT_LIBPERL) `cat ext.libs` $(libs)
# Remove -Zcrtdll
STAT_AOUT_CLDFLAGS = -Zexe -Zmt -Zstack 32000
# Forking dynamically loaded perl with a wrong CRT library:
-perl_stat_aout$(EXE_EXT) perl_stat_aout: $& perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) ext.libs
- $(SHRPENV) $(CC) $(STAT_AOUT_CLDFLAGS) $(CCDLFLAGS) -o $@ perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) `cat ext.libs` $(libs)
+perl_stat_aout$(EXE_EXT) perl_stat_aout: $& libperl_dllmain$(AOUT_LIB_EXT)
+ $(SHRPENV) $(CC) $(STAT_AOUT_CLDFLAGS) $(CCDLFLAGS) $(OPTIMIZE) -o perl_stat_aout libperl_dllmain$(AOUT_LIB_EXT)
PERLREXX_DLL = perlrexx.dll
-perl : perl__ perl___ $(PERLREXX_DLL)
+perl perl$(EXE_EXT) : perl__ perl___ $(PERLREXX_DLL) $(PERL_DLL)
# Dynamically loaded PM-application perl:
-perl__$(EXE_EXT) perl__: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl__ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /PM:PM
+perl__$(EXE_EXT) perl__: $& libperl_dllmain$(LIB_EXT)
+ $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl__ libperl_dllmain$(LIB_EXT) -Zlinker /PM:PM
# Forking dynamically loaded perl:
-perl$(EXE_EXT) perl: $& perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) ext.libs
- $(CC) $(AOUT_CLDFLAGS_DLL) $(CCDLFLAGS) -o perl perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) `cat ext.libs` $(libs)
+perl$(EXE_EXT) perl: $& libperl_dllmain$(AOUT_LIB_EXT)
+ $(CC) $(AOUT_CLDFLAGS_DLL) $(CCDLFLAGS) -o perl libperl_dllmain$(AOUT_LIB_EXT)
clean: aout_clean
aout_clean:
- -rm *perl_.* *.o *.a lib/auto/*/*.a ext/*/Makefile.aout
+ -rm *perl_.* *.o *.a lib/auto/*/*.a lib/auto/*/*/*.a lib/auto/*/*/*/*.a ext/*/Makefile.aout ext/*/*/Makefile.aout ext/*/*/*/Makefile.aout
aout_install: perl_ aout_install.perl
all_test: test aout_test perl___test sys_test stat_test stat_aout_test
-all_harness: test_harness aout_harness perl___harness sys_harness stat_harness stat_aout_harness
+test_harness_redir: test_prep
+ -PERL=./perl $(MAKE) TESTFILE=harness _test $(REDIR_TEST)
+
+all_harness: test_harness_redir aout_harness perl___harness sys_harness stat_harness stat_aout_harness
!NO!SUBS!
else
# Need to treat subsubdirectories manually
dd_treated=''
- for ddd in $dd/*
+ for ddd in $dd/* # ext/*/*/*/Makefile.PL
do
if test ! -d $ddd; then
continue
fi
done
+# ext/threads is marked as NORECURS, so we need to specialcase it
+if echo "$static_ext $dynamic_ext" | grep -q threads/shared ; then
+ preci="$preci ext/threads/%/Makefile.aout"
+ dirs="$dirs ext/threads"
+fi
+
$spitshell >>Makefile <<!GROK!THIS!
.PRECIOUS : $preci
PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
static APIRET APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
RexxFunctionHandler *);
+static APIRET APIENTRY (*pRexxRegisterSubcomExe) (PCSZ pszEnvName, PFN pfnEntryPoint,
+ PUCHAR pUserArea);
static APIRET APIENTRY (*pRexxDeregisterFunction) (PSZ);
static ULONG (*pRexxVariablePool) (PSHVBLOCK pRequest);
*(PFN *)&pRexxDeregisterFunction
= loadByOrdinal(ORD_RexxDeregisterFunction, 1);
*(PFN *)&pRexxVariablePool = loadByOrdinal(ORD_RexxVariablePool, 1);
+ *(PFN *)&pRexxRegisterSubcomExe
+ = loadByOrdinal(ORD_RexxRegisterSubcomExe, 1);
needstrs(8);
needvars(8);
trace = getenv("PERL_REXX_DEBUG");
- rc = RexxRegisterSubcomExe("PERLEVAL", (PFN)&SubCommandPerlEval, NULL);
+ rc = pRexxRegisterSubcomExe("PERLEVAL", (PFN)&SubCommandPerlEval, NULL);
}
static int
{&pmwin_handle, NULL, 780}, /* WinLoadPointer */
{&pmwin_handle, NULL, 828}, /* WinQuerySysPointer */
{&doscalls_handle, NULL, 417}, /* DosReplaceModule */
+ {&doscalls_handle, NULL, 976}, /* DosPerfSysCall */
+ {&rexxapi_handle, "RexxRegisterSubcomExe", 0},
};
HMODULE
ULONG rc, buf_len = QSS_INI_BUFFER;
PQTOPLEVEL psi;
- if (!pidtid_lookup) {
- pidtid_lookup = 1;
- *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
- }
- if (pDosVerifyPidTid) { /* Warp3 or later */
- /* Up to some fixpak QuerySysState() kills the system if a non-existent
- pid is used. */
- if (CheckOSError(pDosVerifyPidTid(pid, 1)))
- return 0;
+ if (pid) {
+ if (!pidtid_lookup) {
+ pidtid_lookup = 1;
+ *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
+ }
+ if (pDosVerifyPidTid) { /* Warp3 or later */
+ /* Up to some fixpak QuerySysState() kills the system if a non-existent
+ pid is used. */
+ if (CheckOSError(pDosVerifyPidTid(pid, 1)))
+ return 0;
+ }
}
New(1322, pbuffer, buf_len, char);
/* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
does not append ".exe", so we could have
reached this place). */
sv_catpv(scrsv, ".exe");
- scr = SvPV(scrsv, n_a); /* Reload */
+ PL_Argv[0] = scr = SvPV(scrsv, n_a); /* Reload */
if (PerlLIO_stat(scr,&PL_statbuf) >= 0
&& !S_ISDIR(PL_statbuf.st_mode)) { /* Found */
real_name = scr;
XSRETURN_EMPTY;
}
+/* APIRET APIENTRY DosPerfSysCall(ULONG ulCommand, ULONG ulParm1,
+ ULONG ulParm2, ULONG ulParm3); */
+
+DeclOSFuncByORD(ULONG,perfSysCall,ORD_DosPerfSysCall,
+ (ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3),
+ (ulCommand, ulParm1, ulParm2, ulParm3))
+
+#ifndef CMD_KI_RDCNT
+# define CMD_KI_RDCNT 0x63
+#endif
+#ifndef CMD_KI_GETQTY
+# define CMD_KI_GETQTY 0x41
+#endif
+#ifndef QSV_NUMPROCESSORS
+# define QSV_NUMPROCESSORS 26
+#endif
+
+typedef unsigned long long myCPUUTIL[4]; /* time/idle/busy/intr */
+
+/*
+NO_OUTPUT ULONG
+perfSysCall(ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3)
+ PREINIT:
+ ULONG rc;
+ POSTCALL:
+ if (!RETVAL)
+ croak_with_os2error("perfSysCall() error");
+ */
+
+static int
+numprocessors(void)
+{
+ ULONG res;
+
+ if (DosQuerySysInfo(QSV_NUMPROCESSORS, QSV_NUMPROCESSORS, (PVOID)&res, sizeof(res)))
+ return 1; /* Old system? */
+ return res;
+}
+
+XS(XS_OS2_perfSysCall); /* prototype to pass -Wmissing-prototypes */
+XS(XS_OS2_perfSysCall)
+{
+ dXSARGS;
+ if (items < 0 || items > 4)
+ Perl_croak(aTHX_ "Usage: OS2::perfSysCall(ulCommand = CMD_KI_RDCNT, ulParm1= 0, ulParm2= 0, ulParm3= 0)");
+ SP -= items;
+ {
+ dXSTARG;
+ ULONG RETVAL, ulCommand, ulParm1, ulParm2, ulParm3, res;
+ myCPUUTIL u[64];
+ int total = 0, tot2 = 0;
+
+ if (items < 1)
+ ulCommand = CMD_KI_RDCNT;
+ else {
+ ulCommand = (ULONG)SvUV(ST(0));
+ }
+
+ if (items < 2) {
+ total = (ulCommand == CMD_KI_RDCNT ? numprocessors() : 0);
+ ulParm1 = (total ? (ULONG)u : 0);
+
+ if (total > C_ARRAY_LENGTH(u))
+ croak("Unexpected number of processors: %d", total);
+ } else {
+ ulParm1 = (ULONG)SvUV(ST(1));
+ }
+
+ if (items < 3) {
+ tot2 = (ulCommand == CMD_KI_GETQTY);
+ ulParm2 = (tot2 ? (ULONG)&res : 0);
+ } else {
+ ulParm2 = (ULONG)SvUV(ST(2));
+ }
+
+ if (items < 4)
+ ulParm3 = 0;
+ else {
+ ulParm3 = (ULONG)SvUV(ST(3));
+ }
+
+ RETVAL = perfSysCall(ulCommand, ulParm1, ulParm2, ulParm3);
+ if (!RETVAL)
+ croak_with_os2error("perfSysCall() error");
+ if (total) {
+ int i,j;
+
+ if (GIMME_V != G_ARRAY) {
+ PUSHn(u[0][0]); /* Total ticks on the first processor */
+ XSRETURN(1);
+ }
+ for (i=0; i < total; i++)
+ for (j=0; j < 4; j++)
+ PUSHs(sv_2mortal(newSVnv(u[i][j])));
+ XSRETURN(4*total);
+ }
+ if (tot2) {
+ PUSHu(res);
+ XSRETURN(1);
+ }
+ }
+ XSRETURN_EMPTY;
+}
#define PERL_PATCHLEVEL_H_IMPLICIT /* Do not init local_patches. */
#include "patchlevel.h"
newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file);
newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file);
newXS("OS2::replaceModule", XS_OS2_replaceModule, file);
+ newXS("OS2::perfSysCall", XS_OS2_perfSysCall, file);
newXSproto("OS2::_control87", XS_OS2__control87, file, "$$");
newXSproto("OS2::get_control87", XS_OS2_get_control87, file, "");
newXSproto("OS2::set_control87", XS_OS2_set_control87, file, ";$$");
#ifdef PERL_IS_AOUT
sv_setiv(GvSV(gv), 1);
#endif
+ gv = gv_fetchpv("OS2::is_static", TRUE, SVt_PV);
+ GvMULTI_on(gv);
+#ifdef PERL_IS_AOUT
+ sv_setiv(GvSV(gv), 1);
+#endif
gv = gv_fetchpv("OS2::can_fork", TRUE, SVt_PV);
GvMULTI_on(gv);
sv_setiv(GvSV(gv), exe_is_aout());
_control87(MCW_EM, MCW_EM);
}
+int
+fd_ok(int fd)
+{
+ static ULONG max_fh = 0;
+
+ if (!(_emx_env & 0x200)) return 1; /* not OS/2. */
+ if (fd >= max_fh) { /* Renew */
+ LONG delta = 0;
+
+ if (DosSetRelMaxFH(&delta, &max_fh)) /* Assume it OK??? */
+ return 1;
+ }
+ return fd < max_fh;
+}
+
+/* Kernels up to Oct 2003 trap on (invalid) dup(max_fh); [off-by-one + double fault]. */
+int
+dup2(int from, int to)
+{
+ if (fd_ok(from < to ? to : from))
+ return _dup2(from, to);
+ errno = EBADF;
+ return -1;
+}
+
+int
+dup(int from)
+{
+ if (fd_ok(from))
+ return _dup(from);
+ errno = EBADF;
+ return -1;
+}
+
#undef tmpnam
#undef tmpfile
like($lpe, qr/\Q$s_cwd/);
-is(uc OS2::DLLname(1), uc $Config{dll_name});
-like(OS2::DLLname, qr#\Q/$Config{dll_name}\E\.dll$#i );
-(my $root_cwd = $s_cwd) =~ s,/t$,,;
-like(OS2::DLLname, qr#^\Q$root_cwd\E(/t)?\Q/$Config{dll_name}\E\.dll#i );
+if (uc OS2::DLLname() eq uc $^X) { # Static build
+ my ($short) = ($^X =~ m,.*[/\\]([^.]+),);
+ is(uc OS2::DLLname(1), uc $short);
+ is(uc OS2::DLLname, uc $^X ); # automatically
+ is(1,1); # automatically...
+} else {
+ is(uc OS2::DLLname(1), uc $Config{dll_name});
+ like(OS2::DLLname, qr#\Q/$Config{dll_name}\E\.dll$#i );
+ (my $root_cwd = $s_cwd) =~ s,/t$,,;
+ like(OS2::DLLname, qr#^\Q$root_cwd\E(/t)?\Q/$Config{dll_name}\E\.dll#i );
+}
is(OS2::DLLname, OS2::DLLname(2));
like(OS2::DLLname(0), qr#^(\d+)$# );
ORD_WinLoadPointer,
ORD_WinQuerySysPointer,
ORD_DosReplaceModule,
+ ORD_DosPerfSysCall,
+ ORD_RexxRegisterSubcomExe,
ORD_NENTRIES
};
$idir = $Config{installbin};
$indir =~ s|\\|/|g ;
+my %seen;
+
foreach $file (<$idir/*>) {
- next if $file =~ /\.exe/i;
+ next if $file =~ /\.(exe|bak)/i;
$base = $file;
$base =~ s/\.$//; # just in case...
$base =~ s|.*/||;
- $file =~ s|/|\\|g ;
+ $base =~ s|\.pl$||;
+ #$file =~ s|/|\\|g ;
+ warn "Clashing output name for $file, skipping" if $seen{$base}++;
print "Processing $file => $dir\\$base.cmd\n";
- system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd";
- system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd";
+ open IN, '<', $file or warn, next;
+ open OUT, '>', "$dir/$base.cmd" or warn, next;
+ my $firstline = <IN>;
+ my $flags = '';
+ $flags = $2 if $firstline =~ /^#!\s*(\S+)\s+-([^#]+?)\s*(#|$)/;
+ print OUT "extproc perl -S$flags\n$firstline";
+ print OUT $_ while <IN>;
+ close IN or warn, next;
+ close OUT or warn, next;
}
*/
f->_file = -1;
return 1;
+# elif defined(__EMX__)
+ /* f->_flags &= ~_IOOPEN; */ /* Will leak stream->_buffer */
+ f->_handle = -1;
+ return 1;
# elif defined(__CYGWIN__)
/* There may be a better way on CYGWIN:
- we could insert a dummy func in the _close function entry
projects / p5sagit/p5-mst-13.2.git / commitdiff