X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=os2%2Fos2.c;h=a2b196e3eb261fcf5a29f8a7874cb2764f0603e6;hb=a85af077429e952fee988d4fbff702eca28546d1;hp=4ce933d81b4e3bcba4af6b2f09634e504af11c30;hpb=9c130f5bf137a33b7d9b08f028572692c4035032;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/os2/os2.c b/os2/os2.c
index 4ce933d..a2b196e 100644
--- 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);