From 04b535e8cf163ebe6e7fa3d3b6e86bf47f5604c1 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 20 Feb 2017 19:27:27 -0800
Subject: bugfix: accept allowing binding escape.

The issue is that if @(accept) traverses a pattern function
call boundary, the rules for resolving bindings when
terminating a function are being ignored. For instance,
this test case ends with a and x being bound to "y"
and "x":

  @(define fun (a))
  @(bind x "x")
  @(accept a)
  @(end)
  @(block a)
  @(fun "y")
  @(end)

the right behavior is that there are no bindings at all.
When the accept control transfer terminates (fun "y"),
binding resolution must take place as if the function
terminated normally. This resolution, in this particular
case, suppresses the a and x bindings which are local,
so that the test case terminates with no bindings.

* match.c (fun_intercept_accept): New static function.
(h_fun, v_fun): Set up an unwind handler which calls
fun_intercept_accept to catch accepts and fix-up
their bindings.
---
 match.c | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/match.c b/match.c
index 6dada049..7f046fb0 100644
--- a/match.c
+++ b/match.c
@@ -1258,6 +1258,21 @@ static val fun_resolve_bindings(val bindings, val ub_p_a_pairs,
   return bindings;
 }
 
+static void fun_intercept_accept(val bindings, val ub_p_a_pairs,
+                                 val sym, val elem)
+{
+  uw_frame_t *ex = uw_current_exit_point();
+  if (ex && ex->uw.type == UW_BLOCK && ex->bl.protocol == accept_s) {
+    loc ab_loc = vecref_l(ex->bl.result, zero);
+    val accept_bindings = deref(ab_loc);
+    bindings = fun_resolve_bindings(bindings, ub_p_a_pairs,
+                                    accept_bindings, sym, elem);
+    if (bindings == t)
+      bindings = nil;
+
+    set(ab_loc, bindings);
+  }
+}
 
 static val h_fun(match_line_ctx *c)
 {
@@ -1303,8 +1318,16 @@ static val h_fun(match_line_ctx *c)
       uw_env_begin;
       debug_frame(sym, args, ub_p_a_pairs, c->bindings, c->dataline, c->data_lineno, c->pos);
 
+      uw_simple_catch_begin;
+
       result = match_line(ml_bindings_specline(*c, bindings_cp, body));
 
+      uw_unwind {
+        fun_intercept_accept(c->bindings, ub_p_a_pairs, sym, elem);
+      }
+
+      uw_catch_end;
+
       debug_end;
       uw_env_end;
       uw_block_end;
@@ -3962,7 +3985,17 @@ static val v_fun(match_files_ctx *c)
       uw_env_begin;
       debug_frame(sym, args, ub_p_a_pairs, c->bindings, if2(consp(c->data), car(c->data)),
                   c->data_lineno, nil);
+
+      uw_simple_catch_begin;
+
       result = match_files(mf_spec_bindings(*c, body, bindings_cp));
+
+      uw_unwind {
+        fun_intercept_accept(c->bindings, ub_p_a_pairs, sym, specline);
+      }
+
+      uw_catch_end;
+
       debug_end;
       uw_env_end;
       uw_block_end;
-- 
cgit v1.2.3