clang thread safety annotations

http://clang.llvm.org/docs/ThreadSafetyAnalysis.html

Static (compile-time) annotations for declaring the multithreaded
behavior of functions, variables, and capabilities (like mutexes).
Available since about clang 3.5.

./Configure -des -Dusedevel -Dusethreads -Dcc=clang -Accflags='-Wthread-safety'

clang -Wthread-safety then checks the validity of the annotations.

3 files changed, 147 insertions, 3 deletions

diff --git a/perl.h b/perl.h
index c11548db22..cddae1519b 100644
--- a/perl.h
+++ b/perl.h
@@ -3052,6 +3052,101 @@ freeing any remaining Perl interpreters.
  * May make sense to have threads after "*ish.h" anyway
  */
 
+/* clang Thread Safety Analysis/Annotations/Attributes
+ * http://clang.llvm.org/docs/ThreadSafetyAnalysis.html
+ *
+ * Available since clang 3.5-ish (appeared in 3.4, but shaky).
+ * Apple XCode hijacks __clang_major__ and __clang_minor__
+ * (6.0 means really clang 3.5), so needs extra hijinks.
+ */
+#if defined(USE_ITHREADS) && defined(I_PTHREAD) && \
+    defined(__clang__) && \
+    !defined(SWIG) && \
+  ((!defined(__apple_build_version__) &&               \
+    ((__clang_major__ == 3 && __clang_minor__ >= 5) || \
+     (__clang_major__ > 4))) || \
+   (defined(__apple_build_version__) &&                \
+    ((__clang_major__ >= 6))))
+#  define PERL_TSA__(x)   __attribute__((x))
+#  define PERL_TSA_ACTIVE
+#else
+#  define PERL_TSA__(x)   /* No TSA, make TSA attributes no-ops. */
+#  undef PERL_TSA_ACTIVE
+#endif
+
+/* PERL_TSA_CAPABILITY() is used to annotate typedefs.
+ * typedef old_type PERL_TSA_CAPABILITY("mutex") new_type;
+ */
+#define PERL_TSA_CAPABILITY(x) \
+    PERL_TSA__(capability(x))
+
+/* In the below examples the mutex must be lexically visible, usually
+ * either as global variables, or as function arguments. */
+
+/* PERL_TSA_GUARDED_BY() is used to annotate global variables.
+ *
+ * Foo foo PERL_TSA_GUARDED_BY(mutex);
+ */
+#define PERL_TSA_GUARDED_BY(x) \
+    PERL_TSA__(guarded_by(x))
+
+/* PERL_TSA_PT_GUARDED_BY() is used to annotate global pointers.
+ * The data _behind_ the pointer is guarded.
+ *
+ * Foo* ptr PERL_TSA_PT_GUARDED_BY(mutex);
+ */
+#define PERL_TSA_PT_GUARDED_BY(x) \
+    PERL_TSA__(pt_guarded_by(x))
+
+/* PERL_TSA_REQUIRES() is used to annotate functions.
+ * The caller MUST hold the resource when calling the function.
+ *
+ * void Foo() PERL_TSA_REQUIRES(mutex);
+ */
+#define PERL_TSA_REQUIRES(x) \
+    PERL_TSA__(requires_capability(x))
+
+/* PERL_TSA_EXCLUDES() is used to annotate functions.
+ * The caller MUST NOT hold resource when calling the function.
+ *
+ * EXCLUDES should be used when the function first acquires
+ * the resource and then releases it.  Use to avoid deadlock.
+ *
+ * void Foo() PERL_TSA_EXCLUDES(mutex);
+ */
+#define PERL_TSA_EXCLUDES(x) \
+    PERL_TSA__(locks_excluded(x))
+
+/* PERL_TSA_ACQUIRE() is used to annotate functions.
+ * The caller MUST NOT hold the resource when calling the function,
+ * and the function will acquire the resource.
+ *
+ * void Foo() PERL_TSA_ACQUIRE(mutex);
+ */
+#define PERL_TSA_ACQUIRE(x) \
+    PERL_TSA__(acquire_capability(x))
+
+/* PERL_TSA_RELEASE() is used to annotate functions.
+ * The caller MUST hold the resource when calling the function,
+ * and the function will release the resource.
+ *
+ * void Foo() PERL_TSA_RELEASE(mutex);
+ */
+#define PERL_TSA_RELEASE(x) \
+    PERL_TSA__(release_capability(x))
+
+/* PERL_TSA_NO_TSA is used to annotate functions.
+ * Used when being intentionally unsafe, or when the code is too
+ * complicated for the analysis.  Use sparingly.
+ *
+ * void Foo() PERL_TSA_NO_TSA;
+ */
+#define PERL_TSA_NO_TSA \
+    PERL_TSA__(no_thread_safety_analysis)
+
+/* There are more annotations/attributes available, see the clang
+ * documentation for details. */
+
 #if defined(USE_ITHREADS)
 #  ifdef NETWARE
 #   include <nw5thread.h>
@@ -3073,7 +3168,7 @@ typedef void *		perl_key;
 #            include <pthread.h>
 #          endif
 typedef pthread_t	perl_os_thread;
-typedef pthread_mutex_t	perl_mutex;
+typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex;
 typedef pthread_cond_t	perl_cond;
 typedef pthread_key_t	perl_key;
 #        endif /* I_MACH_CTHREADS */
@@ -3082,6 +3177,25 @@ typedef pthread_key_t	perl_key;
 #  endif /* NETWARE */
 #endif /* USE_ITHREADS */
 
+#ifdef PERL_TSA_ACTIVE
+/* Since most pthread mutex interfaces have not been annotated, we
+ * need to have these wrappers. The NO_TSA annotation is quite ugly
+ * but it cannot be avoided in plain C, unlike in C++, where one could
+ * e.g. use ACQUIRE() with no arg on a mutex lock method.
+ *
+ * The bodies of these wrappers are in util.c
+ *
+ * TODO: however, some platforms are starting to get these clang
+ * thread safety annotations for pthreads, for example FreeBSD.
+ * Do we need a way to a bypass these wrappers? */
+int perl_tsa_mutex_lock(perl_mutex* mutex)
+  PERL_TSA_ACQUIRE(*mutex)
+  PERL_TSA_NO_TSA;
+int perl_tsa_mutex_unlock(perl_mutex* mutex)
+  PERL_TSA_RELEASE(*mutex)
+  PERL_TSA_NO_TSA;
+#endif
+
 #if defined(WIN32)
 #  include "win32.h"
 #endif
diff --git a/thread.h b/thread.h
index 1fb1cc6131..9958a5bffb 100644
--- a/thread.h
+++ b/thread.h
@@ -208,10 +208,18 @@
     } STMT_END
 #  endif
 
+#  ifdef PERL_TSA_ACTIVE
+#    define perl_pthread_mutex_lock(m) perl_tsa_mutex_lock(m)
+#    define perl_pthread_mutex_unlock(m) perl_tsa_mutex_unlock(m)
+#  else
+#    define perl_pthread_mutex_lock(m) pthread_mutex_lock(m)
+#    define perl_pthread_mutex_unlock(m) pthread_mutex_unlock(m)
+#  endif
+
 #  define MUTEX_LOCK(m) \
     STMT_START {						\
 	int _eC_;						\
-	if ((_eC_ = pthread_mutex_lock((m))))			\
+	if ((_eC_ = perl_pthread_mutex_lock((m))))			\
 	    Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]",	\
 				 _eC_, __FILE__, __LINE__);	\
     } STMT_END
@@ -219,7 +227,7 @@
 #  define MUTEX_UNLOCK(m) \
     STMT_START {						\
 	int _eC_;						\
-	if ((_eC_ = pthread_mutex_unlock((m))))			\
+	if ((_eC_ = perl_pthread_mutex_unlock((m))))			\
 	    Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]",	\
 				 _eC_, __FILE__, __LINE__);	\
     } STMT_END
diff --git a/util.c b/util.c
index ab468fec5f..4d66fe5bd0 100644
--- a/util.c
+++ b/util.c
@@ -6577,6 +6577,28 @@ Perl_dump_c_backtrace(pTHX_ PerlIO* fp, int depth, int skip)
 
 #endif /* #ifdef USE_C_BACKTRACE */
 
+#ifdef PERL_TSA_ACTIVE
+
+/* pthread_mutex_t and perl_mutex are typedef equivalent
+ * so casting the pointers is fine. */
+
+int perl_tsa_mutex_lock(perl_mutex* mutex)
+{
+    return pthread_mutex_lock((pthread_mutex_t *) mutex);
+}
+
+int perl_tsa_mutex_unlock(perl_mutex* mutex)
+{
+    return pthread_mutex_unlock((pthread_mutex_t *) mutex);
+}
+
+int perl_tsa_mutex_destroy(perl_mutex* mutex)
+{
+    return pthread_mutex_destroy((pthread_mutex_t *) mutex);
+}
+
+#endif
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */