fix dynamic-wind matching for continuation jumps

Thanks to Gustavo and Robby for tracking down the relevant feature
of a complex example that was found by random testing.

pkgs/racket-test-core/tests/racket/prompt.rktl

@@ -500,6 +500,89 @@
      (grab N M void 10))
    p))
 
+;; ----------------------------------------
+;; Check that a non-composable-continuation jump isn't
+;; fooled by a dynamic-wind frame that is common to the
+;; source and destination but not followed by all
+;; matching frames.
+
+(let ()
+  (define accum null)
+  (define (output! v) (set! accum (cons v accum)))
+  (define (check-output! expect)
+    (let ([got (reverse accum)])
+      (set! accum null)
+      (displayln got)
+      (test expect values got)))
+
+  ;; Make a composable continuation that holds one dynamic-wind frame
+  (define (make-composable-dw pre post)
+    (call-with-continuation-prompt
+     (lambda ()
+       (dynamic-wind
+        (lambda () (output! pre))
+        (lambda () ((call-with-composable-continuation
+                (lambda (k) (lambda () k)))))
+        (lambda () (output! post))))))
+
+  (define dw1 (make-composable-dw "+1" "-1"))
+  (check-output! '("+1" "-1"))
+
+  (define dw2 (make-composable-dw "+2" "-2"))
+  (check-output! '("+2" "-2"))
+
+  (define dw3 (make-composable-dw "+3" "-3"))
+  (check-output! '("+3" "-3"))
+
+  (define (compose-dw a-dw b-dw)
+    (lambda (f)
+      (a-dw (lambda () (b-dw f)))))
+
+  ;; compose dw1 and dw2, with "work" in the middle:
+  ((compose-dw dw1 dw2) (lambda () (output! "work")))
+  (check-output! '("+1" "+2" "work" "-2" "-1"))
+
+  ;; Compose two composable continuations, and capture the composition
+  ;; as non-composable:
+  (define (make-non-composable dw)
+    (call-with-continuation-prompt
+     (lambda ()
+       (dw
+        (lambda ()
+          ((call/cc
+            (lambda (k) (lambda () k)))))))))
+
+  (define dw2+dw1 (make-non-composable (compose-dw dw2 dw1)))
+  (check-output! '("+2" "+1" "-1" "-2"))
+
+  (define dw3+dw1 (make-non-composable (compose-dw dw3 dw1)))
+  (check-output! '("+3" "+1" "-1" "-3"))
+
+  (call-with-continuation-prompt
+   (lambda ()
+     (dw2+dw1 (lambda () (output! "inside")))))
+  (check-output! '("+2" "+1" "inside" "-1" "-2"))
+
+  (define dw3+dw2+dw1 (make-non-composable (compose-dw (compose-dw dw3 dw2) dw1)))
+  (check-output! '("+3" "+2" "+1" "-1" "-2" "-3"))
+
+  ;; From a dw3+dw2+d1 composition, jump to a dw2+dw1 composition;
+  ;; even though the sourec and destination both have dw2 and dw1
+  ;; innermost, the full chains are different, so the jump goes
+  ;; all the way out of dw3+dw2+dw1 and back into dw2+dw1
+  (call-with-continuation-prompt
+   (lambda ()
+     (dw3+dw2+dw1 (lambda () (dw2+dw1 (lambda () (output! "inside")))))))
+  (check-output! '("+3" "+2" "+1" "-1" "-2" "-3" "+2" "+1" "inside" "-1" "-2"))
+
+  ;; From a dw2+d1 composition, jump to a dw3+dw1 composition;
+  ;; this one should still jump all the way out and all the way
+  ;; back in:
+  (call-with-continuation-prompt
+   (lambda ()
+     (dw2+dw1 (lambda () (dw3+dw1 (lambda () (output! "inside")))))))
+  (check-output! '("+2" "+1" "-1" "-2" "+3" "+1" "inside" "-1" "-3")))
+
 ;;----------------------------------------
 
 (report-errs)

racket/src/racket/src/eval.c

@@ -1472,7 +1472,7 @@ static Scheme_Dynamic_Wind *intersect_dw(Scheme_Dynamic_Wind *a, Scheme_Dynamic_
 {
   int alen = 0, blen = 0;
   int a_has_tag = 0, a_prompt_delta = 0, b_prompt_delta = 0;
-  Scheme_Dynamic_Wind *dw;
+  Scheme_Dynamic_Wind *dw, *match_a, *match_b;
 
   for (dw = a; dw && (dw->prompt_tag != prompt_tag); dw = dw->prev) {
   }
@@ -1504,18 +1504,32 @@ static Scheme_Dynamic_Wind *intersect_dw(Scheme_Dynamic_Wind *a, Scheme_Dynamic_
   }
 
   /* At this point, we have chains that are the same length. */
+  match_a = NULL;
+  match_b = NULL;
   while (blen) {
     if (SAME_OBJ(a->id ? a->id : (Scheme_Object *)a, 
-                 b->id ? b->id : (Scheme_Object *)b))
-      break;
+                 b->id ? b->id : (Scheme_Object *)b)) {
+      if (!match_a) {
+        match_a = a;
+        match_b = b;
+      }
+    } else {
+      match_a = NULL;
+      match_b = NULL;
+    }
     a = a->prev;
     b = b->prev;
     blen--;
   }
 
-  *_common_depth = (b ? b->depth : -1);
+  if (!match_a) {
+    match_a = a;
+    match_b = b;
+  }
 
-  return a;
+  *_common_depth = (match_b ? match_b->depth : -1);
+
+  return match_a;
 }
 
 static Scheme_Prompt *lookup_cont_prompt(Scheme_Cont *c,