From 7e3db187cc7bea62b05de5b68fda5429c73c6717 Mon Sep 17 00:00:00 2001
From: Alexis King <lexi.lambda@gmail.com>
Date: Wed, 25 Mar 2026 23:21:40 -0500
Subject: [PATCH] gl-context: Fix re-entrancy of `call-as-current`

---
 .../scribblings/draw/gl-context-intf.scrbl    |  3 +++
 draw-lib/info.rkt                             |  2 +-
 draw-lib/racket/draw/private/gl-context.rkt   | 10 +++++----
 draw-test/tests/racket/draw/gl-context.rkt    | 21 +++++++++++++++++++
 4 files changed, 31 insertions(+), 5 deletions(-)
 create mode 100644 draw-test/tests/racket/draw/gl-context.rkt

diff --git a/draw-doc/scribblings/draw/gl-context-intf.scrbl b/draw-doc/scribblings/draw/gl-context-intf.scrbl
index 213e091..8156999 100644
--- a/draw-doc/scribblings/draw/gl-context-intf.scrbl
+++ b/draw-doc/scribblings/draw/gl-context-intf.scrbl
@@ -74,6 +74,9 @@ If @racket[enable-breaks?] is true, then the method uses
  @racket[sync/enable-break] while blocking for the context-setting
  lock instead of @racket[sync].
 
+@history[#:changed "1.24" @elem{Added support for nested calls from
+          the same thread. (Previous versions were documented to
+          support nesting, but in practice it did not work correctly.)}]
 }
 
 @defmethod[(get-handle) cpointer?]{
diff --git a/draw-lib/info.rkt b/draw-lib/info.rkt
index ade6c45..21048a3 100644
--- a/draw-lib/info.rkt
+++ b/draw-lib/info.rkt
@@ -22,7 +22,7 @@
 
 (define pkg-authors '(mflatt))
 
-(define version "1.23")
+(define version "1.24")
 
 (define license
   '(Apache-2.0 OR MIT))
diff --git a/draw-lib/racket/draw/private/gl-context.rkt b/draw-lib/racket/draw/private/gl-context.rkt
index 9a80134..14f1b50 100644
--- a/draw-lib/racket/draw/private/gl-context.rkt
+++ b/draw-lib/racket/draw/private/gl-context.rkt
@@ -52,7 +52,7 @@
 ;; Implemented by subclasses:
 (define gl-context%
   (class* object% (gl-context<%>)
-    (define/private (with-gl-lock t alternate-evt enable-break?)
+    (define/private (with-gl-lock t wrapped-t alternate-evt enable-break?)
       (thread-resume manager-t (current-thread))
       (define current (channel-get lock-holder-ch))
       (if (and (eq? (vector-ref current 0) (current-thread))
@@ -65,7 +65,7 @@
                            (dynamic-wind
                                (lambda ()
                                  (thread-cell-set! current-gl-context this))
-                               t
+                               wrapped-t
                                (lambda ()
                                  (thread-cell-set! current-gl-context #f)
                                  (channel-put ch #t))))))
@@ -76,15 +76,17 @@
     
     (define/public (call-as-current t [alternate-evt never-evt] [enable-breaks? #f])
       (with-gl-lock
+       t
        (lambda ()
          (do-call-as-current t))
        alternate-evt
        enable-breaks?))
 
     (define/public (swap-buffers)
+      (define (do-swap) (do-swap-buffers))
       (with-gl-lock
-       (lambda ()
-         (do-swap-buffers))
+       do-swap
+       do-swap
        never-evt
        #f))
 
diff --git a/draw-test/tests/racket/draw/gl-context.rkt b/draw-test/tests/racket/draw/gl-context.rkt
new file mode 100644
index 0000000..341994a
--- /dev/null
+++ b/draw-test/tests/racket/draw/gl-context.rkt
@@ -0,0 +1,21 @@
+#lang racket/base
+
+(require racket/class
+         racket/gui/base
+         sgl/gl)
+
+;; Exercise reentrancy of `call-as-current`.
+(define bm (make-gl-bitmap 32 32 (new gl-config%)))
+(define ctx (send (make-object bitmap-dc% bm) get-gl-context))
+(send ctx call-as-current
+      (λ ()
+        (glClearColor 0.0 0.0 0.0 0.0)
+        (glClear GL_COLOR_BUFFER_BIT)
+        (glBegin GL_TRIANGLES)
+        (send ctx call-as-current
+              (λ ()
+                (glVertex2f -1.0 -1.0)
+                (glVertex2f +1.0 -1.0)
+                (glVertex2f -1.0 +1.0)))
+        (glEnd)
+        (glFinish)))