From 49a90ba75e5782d082b98d3505f9abab43cdc232 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 18 Jul 2018 10:42:27 -0600
Subject: [PATCH] expander: repair a race condition related to "available"
 modules

Fix a broken use of a lock intended to prevent threads from
conflicting while forcing "available" modules to "visited" module.
---
 .../racket-test-core/tests/racket/module.rktl | 26 +++++++++++++++++++
 racket/src/expander/namespace/module.rkt      |  2 +-
 racket/src/racket/src/startup.inc             |  8 +++---
 3 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl
index bd484b753a..8e12b38ce7 100644
--- a/pkgs/racket-test-core/tests/racket/module.rktl
+++ b/pkgs/racket-test-core/tests/racket/module.rktl
@@ -2736,6 +2736,32 @@ case of module-leve bindings; it doesn't cover local bindings.
   (dynamic-require '(submod 'm check) #f)
   (eval 'x (module->namespace '(submod 'm check))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Try to provoke race conditions in the expander related
+;; to instanitiating compile-time instances on demand
+
+(test #t
+      'no-races-found
+      (for/and ([i (in-range 100)])
+        (let ([ok? #t]
+              [work 0])
+          (for-each
+           sync
+           (parameterize ([current-namespace (make-base-namespace)])
+             (for/list ([i 5])
+               (thread
+                (lambda ()
+                  ;; "make work" to try to trigger a thread swap during `expand`
+                  (for ([w (in-range (random 1000))])
+                    (set! work (add1 work)))
+                  (with-handlers ([exn? (lambda (exn)
+                                          (set! ok? #f)
+                                          (raise exn))])
+                    ;; This `expand` will force compile-time instances of
+                    ;; various modules used by `racket/base`
+                    (expand `(lambda (x) x))))))))
+          ok?)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)
diff --git a/racket/src/expander/namespace/module.rkt b/racket/src/expander/namespace/module.rkt
index 860a3ddac7..f6e2f1f4b6 100644
--- a/racket/src/expander/namespace/module.rkt
+++ b/racket/src/expander/namespace/module.rkt
@@ -502,9 +502,9 @@
        (let loop ()
          (define mis (hash-ref (namespace-available-module-instances ns) run-phase null))
          (unless (null? mis)
-           (hash-set! (namespace-available-module-instances ns) run-phase null)
            (for ([mi (in-list (reverse mis))])
              (run-module-instance! mi ns #:run-phase run-phase #:skip-run? #f #:otherwise-available? #f))
+           (hash-set! (namespace-available-module-instances ns) run-phase null)
            ;; In case instantiation added more reflectively:
            (loop)))))))
 
diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc
index 794c74b8e9..2a4742501a 100644
--- a/racket/src/racket/src/startup.inc
+++ b/racket/src/racket/src/startup.inc
@@ -14019,10 +14019,6 @@ static const char *startup_source =
 "(void)"
 "(let-values()"
 "(begin"
-"(hash-set!"
-"(namespace-available-module-instances ns_37)"
-" run-phase_4"
-" null)"
 "(let-values(((lst_67)(reverse$1 mis_0)))"
 "(begin"
 "(if(variable-reference-from-unsafe?"
@@ -14072,6 +14068,10 @@ static const char *startup_source =
 " for-loop_91)"
 " lst_67)))"
 "(void)"
+"(hash-set!"
+"(namespace-available-module-instances ns_37)"
+" run-phase_4"
+" null)"
 "(loop_77)))))))))"
 " loop_77)))))))))))))"
 "(case-lambda"