From f8f8921a7415e7c557f8b1d53fd6c4925b6dc600 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 20 Feb 2007 08:22:37 +0000
Subject: [PATCH] properly detect cancelling marks for context check on
 fully-expanded expressions

svn: r5645
---
 src/mzscheme/src/stxobj.c | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c
index 358960db64..1b0e9d1074 100644
--- a/src/mzscheme/src/stxobj.c
+++ b/src/mzscheme/src/stxobj.c
@@ -2499,7 +2499,22 @@ Scheme_Object *scheme_stx_activate_certs(Scheme_Object *o)
 
 int scheme_stx_has_empty_wraps(Scheme_Object *o)
 {
-  return SCHEME_NULLP(((Scheme_Stx *)o)->wraps);
+  WRAP_POS awl;
+  Scheme_Object *mark = NULL, *v;
+
+  WRAP_POS_INIT(awl, ((Scheme_Stx *)o)->wraps);
+  while (!WRAP_POS_END_P(awl)) {
+    v = WRAP_POS_FIRST(awl);
+    if (mark) {
+      if (!SAME_OBJ(mark, v))
+        return 0;
+      mark = NULL;
+    } else
+      mark = v;
+    WRAP_POS_INC(awl);
+  }
+
+  return !mark;
 }
 
 /*========================================================================*/