From 7aff978a1f1b7a9145e0387c8926940b57c26bac Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 10 Dec 2017 08:55:08 -0700
Subject: [PATCH] fix merging of marks when applying a composable continuation

When a composable continuation has continuation marks that should
be merged with marks in the immediate continuation frame when
the continuation is applied, then mergeing did not always work.
It only worked in the case that the merge cadidates are the only
marks, because the merging check used the wrong end of the captured
sequence of marks.
---
 .../tests/racket/prompt-tests.rktl            | 49 +++++++++++++++++++
 racket/src/racket/src/fun.c                   | 12 ++---
 2 files changed, 53 insertions(+), 8 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/prompt-tests.rktl b/pkgs/racket-test-core/tests/racket/prompt-tests.rktl
index 888706338e..cc2d0f1d1c 100644
--- a/pkgs/racket-test-core/tests/racket/prompt-tests.rktl
+++ b/pkgs/racket-test-core/tests/racket/prompt-tests.rktl
@@ -1129,6 +1129,55 @@
                (test #t continuation-mark-set-first #f 'n)
                (loop (sub1 n)))))))))
 
+(let ()
+  (define (check call-with-ignored-composable-continuation)
+    ;; Caputured replacing installed with nested metacontinuations
+    (let ([k (call-with-continuation-prompt
+              (lambda ()
+                (with-continuation-mark
+                 'x
+                 71
+                 (call-with-ignored-composable-continuation
+                  (lambda (k2)
+                    (non-tail
+                     (with-continuation-mark
+                      'x
+                      72
+                      ((call-with-composable-continuation
+                        (lambda (k)
+                          (lambda () k)))))))))))])
+      (test '(72 71)
+            'nested-mc
+            (with-continuation-mark
+             'x 81
+             (k (lambda ()
+                  (continuation-mark-set->list (current-continuation-marks) 'x))))))
+
+    ;; Captured not replacing
+    (let ([k (call-with-continuation-prompt
+              (lambda ()
+                (non-tail
+                 (with-continuation-mark
+                  'x
+                  71
+                  (call-with-ignored-composable-continuation
+                   (lambda (k2)
+                     (non-tail
+                      (with-continuation-mark
+                       'x
+                       72
+                       ((call-with-composable-continuation
+                         (lambda (k)
+                           (lambda () k))))))))))))])
+      (test '(72 71 81)
+            'nested-mc
+            (with-continuation-mark
+             'x 81
+             (k (lambda ()
+                  (continuation-mark-set->list (current-continuation-marks) 'x)))))))
+  (check call-with-composable-continuation)
+  (check (lambda (proc) (proc #f))))
+
 ;; ----------------------------------------
 ;; Olivier Danvy's traversal
 
diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c
index 2ecc783a79..a8de261f6c 100644
--- a/racket/src/racket/src/fun.c
+++ b/racket/src/racket/src/fun.c
@@ -5368,9 +5368,9 @@ void prune_cont_marks(Scheme_Meta_Continuation *resume_mc, Scheme_Cont *cont, Sc
     return;
   }
 
-  for (pos = cont->cont_mark_total, num_coverlap = 0;
-       pos--;
-       num_coverlap++) {
+  for (pos = 0, num_coverlap = 0;
+       pos < cont->cont_mark_total;
+       num_coverlap++, pos++) {
     if (cont->cont_mark_stack_copied[pos].pos != (cont->cont_mark_pos_bottom + 2))
       break;
   }
@@ -5399,7 +5399,7 @@ void prune_cont_marks(Scheme_Meta_Continuation *resume_mc, Scheme_Cont *cont, Sc
       scheme_hash_set(ht, SCHEME_VEC_ELS(extra_marks)[i], val);
     }
   }
-  for (pos = cont->cont_mark_total - 1, i = 0; i < num_coverlap; i++, pos--) {
+  for (pos = 0, i = 0; i < num_coverlap; i++, pos++) {
     scheme_hash_set(ht, 
                     cont->cont_mark_stack_copied[pos].key,
                     NULL);
@@ -8456,10 +8456,6 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
     while (chain) {
       if (chain->key == key)
         if (key_arg != key)
-          /*
-           * TODO: is this the only name that this procedure is called as
-           * publicly?
-           */
           return scheme_chaperone_do_continuation_mark("continuation-mark-set-first",
                                                        1, key_arg, chain->val);
         else