X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fdl_win32.xs;h=6c094d22fd4f0054a8bcdec1a1947b63aaf66da4;hb=51254d33a14eeacb273f244a97f13b86d9e56aa2;hp=fb3e3321f80ba5d5f68c4592d3312c6abd43a7c6;hpb=acfe0abcedaf592fb4b9cb69ce3468308ae99d91;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs
index fb3e332..6c094d2 100644
--- a/win32/dl_win32.xs
+++ b/win32/dl_win32.xs
@@ -32,21 +32,27 @@ calls.
 
 #include "XSUB.h"
 
-static SV *error_sv;
+typedef struct {
+    SV *	x_error_sv;
+} my_cxtx_t;		/* this *must* be named my_cxtx_t */
+
+#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
+#include "dlutils.c"	/* SaveError() etc	*/
+
+#define dl_error_sv	(dl_cxtx.x_error_sv)
 
 static char *
 OS_Error_String(pTHX)
 {
- DWORD err = GetLastError();
- STRLEN len;
- if (!error_sv)
-  error_sv = newSVpvn("",0);
- PerlProc_GetOSError(error_sv,err);
- return SvPV(error_sv,len);
+    dMY_CXT;
+    DWORD err = GetLastError();
+    STRLEN len;
+    if (!dl_error_sv)
+	dl_error_sv = newSVpvn("",0);
+    PerlProc_GetOSError(dl_error_sv,err);
+    return SvPV(dl_error_sv,len);
 }
 
-#include "dlutils.c"	/* SaveError() etc	*/
-
 static void
 dl_private_init(pTHX)
 {
@@ -62,7 +68,7 @@ static int
 dl_static_linked(char *filename)
 {
     char **p;
-    char* ptr;
+    char *ptr, *hptr;
     static char subStr[] = "/auto/";
     char szBuffer[MAX_PATH];
 
@@ -84,7 +90,14 @@ dl_static_linked(char *filename)
 	ptr = szBuffer;
 
     for (p = staticlinkmodules; *p;p++) {
-	if (strstr(ptr, *p)) return 1;
+	if (hptr = strstr(ptr, *p)) {
+	    /* found substring, need more detailed check if module name match */
+	    if (hptr==ptr) {
+		return strcmp(ptr, *p)==0;
+	    }
+	    if (hptr[strlen(*p)] == 0)
+		return hptr[-1]=='/';
+	}
     };
     return 0;
 }
@@ -106,7 +119,7 @@ dl_load_file(filename,flags=0)
 	RETVAL = PerlProc_DynaLoad(filename);
     }
     else
-	RETVAL = (void*) GetModuleHandle(NULL);
+	RETVAL = (void*) Win_GetModuleHandle(NULL);
     DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
@@ -116,6 +129,18 @@ dl_load_file(filename,flags=0)
 	sv_setiv( ST(0), (IV)RETVAL);
   }
 
+int
+dl_unload_file(libref)
+    void *	libref
+  CODE:
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
+    RETVAL = FreeLibrary(libref);
+    if (!RETVAL)
+        SaveError(aTHX_ "unload_file:%s", OS_Error_String(aTHX)) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+  OUTPUT:
+    RETVAL
+
 void *
 dl_find_symbol(libhandle, symbolname)
     void *	libhandle
@@ -157,7 +182,8 @@ dl_install_xsub(perl_name, symref, filename="$Package")
 char *
 dl_error()
     CODE:
-    RETVAL = LastError ;
+    dMY_CXT;
+    RETVAL = dl_last_error;
     OUTPUT:
     RETVAL