rts: Infrastructure for testing with ThreadSanitizer

8 files changed, 110 insertions, 3 deletions

diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 611cd20796..042587ebcc 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -105,13 +105,14 @@ executable hadrian
                        , Settings.Default
                        , Settings.Flavours.Benchmark
                        , Settings.Flavours.Development
+                       , Settings.Flavours.GhcInGhci
                        , Settings.Flavours.Llvm
                        , Settings.Flavours.Performance
                        , Settings.Flavours.Profiled
                        , Settings.Flavours.Quick
                        , Settings.Flavours.QuickCross
                        , Settings.Flavours.Quickest
-                       , Settings.Flavours.GhcInGhci
+                       , Settings.Flavours.ThreadSanitizer
                        , Settings.Flavours.Validate
                        , Settings.Packages
                        , Settings.Parser
diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index 56488f0b0a..0a4439827f 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -4,6 +4,7 @@ module Flavour
     -- * Flavour transformers
   , addArgs
   , splitSections, splitSectionsIf
+  , enableThreadSanitizer
   , enableDebugInfo, enableTickyGhc
   ) where
 
@@ -115,3 +116,12 @@ splitSections :: Flavour -> Flavour
 splitSections = splitSectionsIf (/=ghc)
 -- Disable section splitting for the GHC library. It takes too long and
 -- there is little benefit.
+
+enableThreadSanitizer :: Flavour -> Flavour
+enableThreadSanitizer = addArgs $ mconcat
+    [ builder (Ghc CompileHs) ? arg "-optc-fsanitize=thread"
+    , builder (Ghc CompileCWithGhc) ? (arg "-optc-fsanitize=thread" <> arg "-DTSAN_ENABLED")
+    , builder (Ghc LinkHs) ? arg "-optl-fsanitize=thread"
+    , builder (Cc  CompileC) ? (arg "-fsanitize=thread" <> arg "-DTSAN_ENABLED")
+    , builder (Cabal Flags) ? arg "thread-sanitizer"
+    ]
diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs
index bf4919312b..ff51c01acb 100755
--- a/hadrian/src/Settings.hs
+++ b/hadrian/src/Settings.hs
@@ -14,13 +14,14 @@ import UserSettings (userFlavours, userPackages, userDefaultFlavour)
 import {-# SOURCE #-} Settings.Default
 import Settings.Flavours.Benchmark
 import Settings.Flavours.Development
+import Settings.Flavours.GhcInGhci
 import Settings.Flavours.Llvm
 import Settings.Flavours.Performance
 import Settings.Flavours.Profiled
 import Settings.Flavours.Quick
 import Settings.Flavours.Quickest
 import Settings.Flavours.QuickCross
-import Settings.Flavours.GhcInGhci
+import Settings.Flavours.ThreadSanitizer
 import Settings.Flavours.Validate
 
 import Control.Monad.Except
@@ -58,7 +59,8 @@ hadrianFlavours =
     , quickestFlavour
     , quickCrossFlavour, benchmarkLlvmFlavour
     , performanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour
-    , ghcInGhciFlavour, validateFlavour, slowValidateFlavour ]
+    , ghcInGhciFlavour, validateFlavour, slowValidateFlavour
+    , threadSanitizerFlavour ]
 
 -- | This action looks up a flavour with the name given on the
 --   command line with @--flavour@, defaulting to 'userDefaultFlavour'
diff --git a/hadrian/src/Settings/Flavours/ThreadSanitizer.hs b/hadrian/src/Settings/Flavours/ThreadSanitizer.hs
new file mode 100644
index 0000000000..722370f5cd
--- /dev/null
+++ b/hadrian/src/Settings/Flavours/ThreadSanitizer.hs
@@ -0,0 +1,9 @@
+module Settings.Flavours.ThreadSanitizer (threadSanitizerFlavour) where
+
+import Flavour
+import Settings.Flavours.Validate
+
+threadSanitizerFlavour :: Flavour
+threadSanitizerFlavour =
+  enableThreadSanitizer (validateFlavour
+    { name = "thread-sanitizer" })
diff --git a/includes/Rts.h b/includes/Rts.h
index 5768e0eb7d..1e5a60262b 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -193,6 +193,7 @@ void _assertFail(const char *filename, unsigned int linenum)
 
 /* Parallel information */
 #include "rts/OSThreads.h"
+#include "rts/TSANUtils.h"
 #include "rts/SpinLock.h"
 
 #include "rts/Messages.h"
diff --git a/includes/rts/TSANUtils.h b/includes/rts/TSANUtils.h
new file mode 100644
index 0000000000..00f226d9c6
--- /dev/null
+++ b/includes/rts/TSANUtils.h
@@ -0,0 +1,63 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2006-2019
+ *
+ * Utilities for annotating "safe" data races for Thread Sanitizer
+ * -------------------------------------------------------------------------- */
+
+/*
+ * Note [ThreadSanitizer]
+ * ~~~~~~~~~~~~~~~~~~~~~~~
+ * ThreadSanitizer (abbreviated TSAN) is a library and set of compiler
+ * instrumentation (supported by both GCC and Clang) for checking C/C++ code
+ * for data races.
+ *
+ * In GHC we use it to check the runtime system implementation (but not yet
+ * generated code). TSAN requires that the checked program uses C++11-style
+ * atomics for all potentially-racing accesses. Note that we use the __atomic_*
+ * builtin operations but not the C11 _Atomic types to maintain compatibility
+ * with older compilers.
+ *
+ * In addition to the atomic operations themselves, TSAN provides a variety of
+ * annotation operations which can be used to annotate cases where the
+ * intended semantics are either ambiguous or intentionally racy (known as a
+ * *benign race*).
+ *
+ * Finally, there are a few benign races which we can't easily annotate. To
+ * silence these errors we have a suppressions file in rts/.tsan-suppressions.
+ * In general it's best to add suppressions only as a last resort, when the
+ * more precise annotation functions prove to be insufficient.
+ *
+ * Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual
+ */
+
+#if defined(__SANITIZE_THREAD__)
+#define TSAN_ENABLED
+#elif defined(__has_feature)
+#if __has_feature(thread_sanitizer)
+#define TSAN_ENABLED
+#endif
+#endif
+
+#if defined(TSAN_ENABLED)
+#define TSAN_ANNOTATE_HAPPENS_BEFORE(addr)                              \
+    AnnotateHappensBefore(__FILE__, __LINE__, (void*)(addr))
+#define TSAN_ANNOTATE_HAPPENS_AFTER(addr)                               \
+    AnnotateHappensAfter(__FILE__, __LINE__, (void*)(addr))
+#define TSAN_ANNOTATE_BENIGN_RACE_SIZED(addr,size,desc)                 \
+    AnnotateBenignRaceSized(__FILE__, __LINE__, (void*)(addr), size, desc)
+void AnnotateHappensBefore(const char* f, int l, void* addr);
+void AnnotateHappensAfter(const char* f, int l, void* addr);
+void AnnotateBenignRaceSized(const char *file,
+                             int line,
+                             const volatile void *mem,
+                             long size,
+                             const char *description);
+#else
+#define TSAN_ANNOTATE_HAPPENS_BEFORE(addr)
+#define TSAN_ANNOTATE_HAPPENS_AFTER(addr)
+#define TSAN_ANNOTATE_BENIGN_RACE_SIZED(addr,size,desc)
+#endif
+
+#define TSAN_ANNOTATE_BENIGN_RACE(addr,desc)                            \
+    TSAN_ANNOTATE_BENIGN_RACE_SIZED((void*)(addr), sizeof(*addr), desc)
diff --git a/rts/.tsan-suppressions b/rts/.tsan-suppressions
new file mode 100644
index 0000000000..b990c6cfc1
--- /dev/null
+++ b/rts/.tsan-suppressions
@@ -0,0 +1,9 @@
+# ThreadSanitizer suppressions.
+# See Note [ThreadSanitizer] in includes/rts/TSANUtils.h.
+
+# This is a known race but is benign
+race:capability_is_busy
+
+# This is a benign race during IO manager shutdown (between ioManagerWakeup
+# and GHC.Event.Control.closeControl).
+race:ioManagerWakeup
diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
index 9860951226..08ebd3d7bf 100644
--- a/rts/rts.cabal.in
+++ b/rts/rts.cabal.in
@@ -43,6 +43,12 @@ flag logging
   default: False
 flag dynamic
   default: False
+flag thread-sanitizer
+  description:
+    Enable checking for data races using the ThreadSanitizer (TSAN)
+    mechanism supported by GCC and Clang. See Note [ThreadSanitizer]
+    in @includes/rts/TSANUtils.h@.
+  default: False
 
 library
     -- rts is a wired in package and
@@ -78,6 +84,11 @@ library
     if flag(dynamic)
       extra-dynamic-library-flavours: _thr
 
+    if flag(thread-sanitizer)
+      cc-options: -fsanitize=thread
+      ld-options: -fsanitize=thread
+      extra-libraries: tsan
+
     exposed: True
     exposed-modules:
     if flag(libm)
@@ -165,6 +176,7 @@ library
                       rts/Ticky.h
                       rts/Time.h
                       rts/Timer.h
+                      rts/TSANUtils.h
                       rts/Types.h
                       rts/Utils.h
                       rts/prof/CCS.h