Re: [ID 20010608.010] File::Find re-entrancy

[p5sagit/p5-mst-13.2.git] / os2 / os2.c

diff --git a/os2/os2.c b/os2/os2.c
index 4ce933d..a2b196e 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -205,18 +205,15 @@ loadByOrd(char *modname, ULONG ord)
 {
     if (ExtFCN[ord] == NULL) {
        static HMODULE hdosc = 0;
-       BYTE buf[20];
-       PFN fcn;
+       PFN fcn = (PFN)-1;
        APIRET rc;
 
-       
-       if (!hdosc) {
+       if (!hdosc)
            hdosc = loadModule(modname);
-           if (CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
-               Perl_croak_nocontext(
+       if (CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
+           Perl_croak_nocontext(
                        "This version of OS/2 does not support %s.%i", 
                        modname, loadOrd[ord]);     
-       }
        ExtFCN[ord] = fcn;
     } 
     if ((long)ExtFCN[ord] == -1) 
@@ -1332,7 +1329,18 @@ mod2fname(pTHX_ SV *sv)
 #ifdef USE_THREADS
     sum++;                             /* Avoid conflict of DLLs in memory. */
 #endif 
-    sum += PERL_VERSION * 200 + PERL_SUBVERSION * 2;  /*  */
+   /* We always load modules as *specific* DLLs, and with the full name.
+      When loading a specific DLL by its full name, one cannot get a
+      different DLL, even if a DLL with the same basename is loaded already.
+      Thus there is no need to include the version into the mangling scheme. */
+#if 0
+    sum += PERL_VERSION * 200 + PERL_SUBVERSION * 2;  /* Up to 5.6.1 */
+#else
+#  ifndef COMPATIBLE_VERSION_SUM  /* Binary compatibility with the 5.00553 binary */
+#    define COMPATIBLE_VERSION_SUM (5 * 200 + 53 * 2)
+#  endif
+    sum += COMPATIBLE_VERSION_SUM;
+#endif
     fname[pos] = 'A' + (sum % 26);
     fname[pos + 1] = 'A' + (sum / 26 % 26);
     fname[pos + 2] = '\0';
@@ -2001,21 +2009,31 @@ XS(XS_Cwd_sys_abspath)
 }
 typedef APIRET (*PELP)(PSZ path, ULONG type);
 
+/* Kernels after 2000/09/15 understand this too: */
+#ifndef LIBPATHSTRICT
+#  define LIBPATHSTRICT 3
+#endif
+
 APIRET
-ExtLIBPATH(ULONG ord, PSZ path, ULONG type)
+ExtLIBPATH(ULONG ord, PSZ path, IV type)
 {
+    ULONG what;
+
     loadByOrd("doscalls",ord);         /* Guarantied to load or die! */
-    return (*(PELP)ExtFCN[ord])(path, type);
+    if (type > 0)
+       what = END_LIBPATH;
+    else if (type == 0)
+       what = BEGIN_LIBPATH;
+    else
+       what = LIBPATHSTRICT;
+    return (*(PELP)ExtFCN[ord])(path, what);
 }
 
-#define extLibpath(type)                                               \
-    (CheckOSError(ExtLIBPATH(ORD_QUERY_ELP, to, ((type) ? END_LIBPATH  \
-                                                : BEGIN_LIBPATH)))     \
-     ? NULL : to )
+#define extLibpath(to,type)                                            \
+    (CheckOSError(ExtLIBPATH(ORD_QUERY_ELP, (to), (type))) ? NULL : (to) )
 
 #define extLibpath_set(p,type)                                         \
-    (!CheckOSError(ExtLIBPATH(ORD_SET_ELP, (p), ((type) ? END_LIBPATH  \
-                                                : BEGIN_LIBPATH))))
+    (!CheckOSError(ExtLIBPATH(ORD_SET_ELP, (p), (type))))
 
 XS(XS_Cwd_extLibpath)
 {
@@ -2023,7 +2041,7 @@ XS(XS_Cwd_extLibpath)
     if (items < 0 || items > 1)
        Perl_croak_nocontext("Usage: Cwd::extLibpath(type = 0)");
     {
-       bool    type;
+       IV      type;
        char    to[1024];
        U32     rc;
        char *  RETVAL;
@@ -2031,10 +2049,13 @@ XS(XS_Cwd_extLibpath)
        if (items < 1)
            type = 0;
        else {
-           type = (int)SvIV(ST(0));
+           type = SvIV(ST(0));
        }
 
-       RETVAL = extLibpath(type);
+       to[0] = 1; to[1] = 0;           /* Sometimes no error reported */
+       RETVAL = extLibpath(to, type);
+       if (RETVAL && RETVAL[0] == 1 && RETVAL[1] == 0)
+           Perl_croak_nocontext("panic Cwd::extLibpath parameter");
        ST(0) = sv_newmortal();
        sv_setpv((SV*)ST(0), RETVAL);
     }
@@ -2049,14 +2070,14 @@ XS(XS_Cwd_extLibpath_set)
     {
        STRLEN n_a;
        char *  s = (char *)SvPV(ST(0),n_a);
-       bool    type;
+       IV      type;
        U32     rc;
        bool    RETVAL;
 
        if (items < 2)
            type = 0;
        else {
-           type = (int)SvIV(ST(1));
+           type = SvIV(ST(1));
        }
 
        RETVAL = extLibpath_set(s, type);