JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The snapshot consumes the trap site, and the reason prints once

Browse Source 
A break nested inside a trap's break — a fix candidate evaluated at a
bounds stop raising its own error — copied the outer trap's site into
its snapshot, which is a caret pointing at an unrelated line under the
inner condition's name. snap_push now consumes the global: each
snapshot owns its copy, a nested entry that set no fresh site gets
none, and the outer break keeps its own. Pinned end to end.

The fields section says why the values are missing once, above the
rows, instead of repeating the sentence per field; a row keeps its own
reason only when it has one (no printer for its type).

strip_rebind and shown_names get direct coverage, including the clean
strip a real frame almost never reaches.
This commit is contained in:
Joseph Ferano 2026-09-20 22:32:05 +07:00
parent 7ebb97d327
commit abe7e8cd46
5 changed files with 97 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
emacs/flan-cnr.el
View File

@ -210,24 +210,33 @@ indexing or the division itself, so it sits directly under the headline."
(insert (propertize (concat " not available — "
(or why (flan-cnr--why 'layout)) "\n")
'face 'font-lock-comment-face))
(let ((w (apply #'max 4 (mapcar (lambda (f) (length (nth 0 f))) fields)))
(tw (apply #'max 4 (mapcar (lambda (f) (length (or (nth 1 f) ""))) fields))))
(dolist (f fields)
(let ((start (point))
(name (nth 0 f)) (type (or (nth 1 f) "?")) (value (nth 2 f)))
(insert (format " :%s%s %s%s " name
(make-string (- w (length name)) ?\s)
(propertize type 'face 'font-lock-type-face)
(make-string (- tw (length type)) ?\s)))
(insert (if value value
(propertize
(concat "not read — "
(or (nth 3 f) why "the stop's value was not readable"))
'face 'font-lock-comment-face))
"\n")
(add-text-properties start (point)
(list 'flan-cnr-inspect nil
'mouse-face 'highlight)))))))
(progn
;; The section-wide reason, once, above the rows — repeating it per
;; field was the noise the rewording pass was asked to cut.
(when why
(insert (propertize (concat " not read — " why "\n")
'face 'font-lock-comment-face)))
(let ((w (apply #'max 4 (mapcar (lambda (f) (length (nth 0 f))) fields)))
(tw (apply #'max 4 (mapcar (lambda (f) (length (or (nth 1 f) ""))) fields))))
(dolist (f fields)
(let ((start (point))
(name (nth 0 f)) (type (or (nth 1 f) "?")) (value (nth 2 f)))
(insert (format " :%s%s %s%s " name
(make-string (- w (length name)) ?\s)
(propertize type 'face 'font-lock-type-face)
(make-string (- tw (length type)) ?\s)))
(insert (if value value
;; A field-specific reason — no printer for its type —
;; is that row's own; a bare "not read" defers to the
;; sentence above.
(propertize
(if (nth 3 f) (concat "not read — " (nth 3 f))
"not read")
'face 'font-lock-comment-face))
"\n")
(add-text-properties start (point)
(list 'flan-cnr-inspect nil
'mouse-face 'highlight))))))))
(insert "\n"))
(defun flan-cnr--insert-restarts (state)

10
emacs/test-flan-cider.el
View File

@ -1150,12 +1150,16 @@ would be overwritten. Look again and re-do the edit")
(let ((text (with-current-buffer
(test-flan--cnr (list :condition "Missing" :restarts '("retry")
:fields '(("path" "string" nil)
("tried" "i32" "3"))))
("tried" "i32" "3"))
:fields-why "the stop's value was not readable"))
(buffer-string))))
(test-flan--check "a field is named and typed even with no value"
(string-match-p ":path *string *not read" text))
(test-flan--check "and the missing value gets one short sentence"
(string-match-p "not read — [^[]*\n" text))
(test-flan--check "and the reason is one sentence, said once above the rows"
(and (string-match-p "not read — the stop's value" text)
(= 1 (seq-count
(lambda (l) (string-match-p "not read — " l))
(split-string text "\n")))))
(test-flan--check "a value that is there is simply shown"
(string-match-p ":tried *i32 *3" text))
;; The headline reads the condition's own numbers, so what happened is the

28
test/test_dev.ml
View File

@ -1356,6 +1356,34 @@ let () =
if names <> [ "continue" ] then
fail "restarts at a bad index: %s" (String.concat ", " names)
| _ -> fail "break over a bad index listed no restarts");
(* A break nested inside this one must not inherit the trap's site.
The fix-it-and-retry flow evaluates code *at* the bounds stop; if
that code raises its own error, its break has no trap behind it,
and a caret pointing at the outer stop's indexing under the inner
condition's name would be a plausible-looking lie. The site is
consumed by the snapshot that owns it. *)
let r =
ask
"(:op \"eval-expr\" :code \"(restart-case (do (error (BoundsError {.low 1 .high 2 .length 3})) (i64 0)) (back [] (i64 1)))\" :file \"/tmp/buf.flan\")"
in
if status r <> "error" then
fail "an expression that stopped inside the bounds break answered anyway";
(let r = ask "(:op \"break\")" in
if status r <> "ok" then fail "break inside the bounds break: %s" (status r)
else
match Wire.string_field r "site" with
| None -> ()
| Some site -> fail "the inner break inherited the trap's site: %s" site);
let r = ask "(:op \"restart\" :name \"back\")" in
if status r <> "ok" then
fail "resuming the inner break: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
(* Back on the outer break, whose own snapshot still holds its site. *)
if not
(await (fun () ->
let r = ask "(:op \"break\")" in
status r = "ok" && Wire.string_field r "site" <> None))
then fail "the outer bounds break lost its site after the inner one";
(* And the payoff: taking it resumes, which is the difference between a
stop you can recover from and a dead session. *)
let r = ask "(:op \"restart\" :name \"continue\")" in

27
test/test_session.ml
View File

@ -1174,4 +1174,31 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a class and its caller evaluated together: %s" m);
(* ── What a slot is shown as ──────────────────────────────────────────
[strip_rebind] takes only a trailing ~N — [~] is the reader's delimiter
and a synthesized name like [destructure~nth] carries it for another
reason — and [shown_names] hides the unnamed temps while keeping both
raw spellings when a strip would put one name on two slots. The clean
strip is pinned here because end to end it is nearly unreachable: a
rebind's base name is almost always on the same list. *)
if Session.strip_rebind "r~2" <> "r" then
fail "r~2 did not strip to r";
if Session.strip_rebind "destructure~nth" <> "destructure~nth" then
fail "a non-numeric ~ suffix was stripped";
if Session.strip_rebind "r~" <> "r~" then fail "a bare trailing ~ was stripped";
if Session.strip_rebind "~2" <> "~2" then fail "a name that is only a suffix was stripped";
(let fn snames : Tast.fn =
{ Tast.name = "f"; params = []; ret = Types.Unit; body = [];
fdefers = []; fparent = None; floc = Loc.unknown;
slots = Array.make (Array.length snames) (Types.Int Types.I32);
snames }
in
(match Session.shown_names (fn [| Some "k~2"; None |]) with
| [| Some "k"; None |] -> ()
| _ -> fail "a lone rename did not show under its written name, temp hidden");
(match Session.shown_names (fn [| Some "v"; Some "v~2" |]) with
| [| Some "v"; Some "v~2" |] -> ()
| _ ->
fail "two slots that strip to one name did not keep their raw spellings"));
Test_support.report ~label:"session" ()

8
vendor/agent/flan_agent.c vendored
View File

@ -529,6 +529,14 @@ static int snap_push(int resumable, void *cond) {
if (k > (int64_t)sizeof s->site) k = (int64_t)sizeof s->site;
memcpy(s->site, flan_break_site, (size_t)k);
s->sitelen = (int32_t)k;
/* Consumed, not just read. The trap site clears the global when its hook
* returns — but this loop *is* the hook, so a break nested inside it (a
* fix candidate evaluated at a bounds stop raises its own error) would
* otherwise copy the outer trap's site under the inner condition's name,
* which is a caret pointing at an unrelated line. Each snapshot owns its
* copy; a nested entry that set no fresh site gets none. */
flan_break_site = NULL;
flan_break_site_len = 0;
}
s->total = n;
s->used = 0;