Tcl Source Code

Artifact 06c2c1b147e0aedf9c883c841570102fe3808c14:

Attachment "tclLoadDl-2.patch" to ticket [1967630fff] added by georgeps 2008-05-20 11:15:19.

---

Index: tclLoadDl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDl.c,v
retrieving revision 1.17
diff -u -r1.17 tclLoadDl.c
--- tclLoadDl.c	27 Apr 2008 22:21:33 -0000	1.17
+++ tclLoadDl.c	20 May 2008 03:48:56 -0000
@@ -33,6 +33,13 @@
 #ifndef RTLD_GLOBAL
 #   define RTLD_GLOBAL 0
 #endif
+
+/* 
+ * This is used to protect the dlerror() message state.
+ * The POSIX 2004 standard states: "The dlerror() function need not be reentrant."
+ */
+TCL_DECLARE_MUTEX(dlMutex);
+
 
 /*
  *---------------------------------------------------------------------------
@@ -75,6 +82,12 @@
      */
 
     native = Tcl_FSGetNativePath(pathPtr);
+
+    Tcl_MutexLock(&dlMutex);    
+
+    /* Drain dlerror */
+    (void)dlerror();
+
     handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
     if (handle == NULL) {
 	/*
@@ -101,9 +114,14 @@
 
 	Tcl_AppendResult(interp, "couldn't load file \"",
 		Tcl_GetString(pathPtr), "\": ", errorStr, NULL);
+
+	Tcl_MutexUnlock(&dlMutex);
+
 	return TCL_ERROR;
     }
 
+    Tcl_MutexUnlock(&dlMutex);
+
     *unloadProcPtr = &TclpUnloadFile;
     *loadHandle = (Tcl_LoadHandle) handle;
     return TCL_OK;
@@ -143,6 +161,12 @@
      */
 
     native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
+
+    Tcl_MutexLock(&dlMutex);
+
+    /* Drain dlerror */
+    (void)dlerror();
+
     proc = (Tcl_PackageInitProc *) dlsym(handle,	/* INTL: Native. */
 	    native);
     if (proc == NULL) {
@@ -155,6 +179,11 @@
     }
     Tcl_DStringFree(&ds);
 
+    Tcl_AppendResult(interp, "couldn't find symbol \"", symbol, 
+		     "\": ", dlerror(), NULL);
+
+    Tcl_MutexUnlock(&dlMutex);
+
     return proc;
 }