From 0c8e3765f2d42cea653a239e83b70d518740033e Mon Sep 17 00:00:00 2001
From: Bogdan Popa <bogdan@defn.io>
Date: Mon, 3 May 2021 10:16:14 +0300
Subject: [PATCH] cs,thread: fix `thread-receive-evt` retry proc

Fixes #3813
---
 pkgs/racket-test-core/tests/racket/sync.rktl | 17 +++++++++++++++++
 racket/src/cs/schemified/thread.scm          | 11 ++++++++---
 racket/src/thread/thread.rkt                 |  6 +++++-
 3 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/sync.rktl b/pkgs/racket-test-core/tests/racket/sync.rktl
index 8237c5fbe3..cdeb15f158 100644
--- a/pkgs/racket-test-core/tests/racket/sync.rktl
+++ b/pkgs/racket-test-core/tests/racket/sync.rktl
@@ -1041,6 +1041,23 @@
 ;; make sure it's ok for rewind to be the first action:
 (test (void) thread-wait (thread (lambda () (thread-rewind-receive '(1 2 3)))))
 
+(let* ([t (thread/suspend-to-kill
+           (lambda ()
+             (let loop ()
+               (sync
+                (handle-evt
+                 (thread-receive-evt)
+                 (λ (_)
+                   (channel-put (thread-receive) 'ok)
+                   (loop)))))))]
+       [res (for/list ([_ (in-range 2)])
+              (thread-suspend t)
+              (thread-resume t (current-thread))
+              (define ch (make-channel))
+              (thread-send t ch)
+              (channel-get ch))])
+  (test '(ok ok) values res))
+
 ;; ----------------------------------------
 ;; Unsafe poller
 
diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm
index eab84aa8ff..6bf012b615 100644
--- a/racket/src/cs/schemified/thread.scm
+++ b/racket/src/cs/schemified/thread.scm
@@ -8085,7 +8085,7 @@
                 (begin-unsafe (queue-add-front! (thread-mailbox t_0) msg_0)))
               lst_0))
            (end-atomic)))))))
-(define finish_2470
+(define finish_2013
   (make-struct-type-install-properties
    '(thread-receive-evt)
    0
@@ -8131,7 +8131,12 @@
                         (lambda (v_0) self_0)
                         (lambda () (set-thread-mailbox-wakeup! t_0 void))
                         (lambda () (set! receive_0 void))
-                        (lambda () (add-wakeup-callback!_0)))))))))))))))
+                        (lambda ()
+                          (begin
+                            (add-wakeup-callback!_0)
+                            (if (is-mail? t_0)
+                              (values self_0 #t)
+                              (values #f #f)))))))))))))))))
    (current-inspector)
    #f
    '()
@@ -8146,7 +8151,7 @@
    #f
    0
    0))
-(define effect_2506 (finish_2470 struct:thread-receiver-evt))
+(define effect_2506 (finish_2013 struct:thread-receiver-evt))
 (define thread-receiver-evt26.1
   (|#%name|
    thread-receiver-evt
diff --git a/racket/src/thread/thread.rkt b/racket/src/thread/thread.rkt
index 7a1c7c5115..87b967d93f 100644
--- a/racket/src/thread/thread.rkt
+++ b/racket/src/thread/thread.rkt
@@ -1033,7 +1033,11 @@
                                         ;; abandon:
                                         (lambda () (set! receive void))
                                         ;; retry (was interrupted, but not abandoned):
-                                        (lambda () (add-wakeup-callback!))))])))
+                                        (lambda ()
+                                          (add-wakeup-callback!)
+                                          (if (is-mail? t)
+                                              (values self #t)
+                                              (values #f #f)))))])))
   #:reflection-name 'thread-receive-evt)
 
 (define/who (thread-receive-evt)