diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index dd3e319..6f92758 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -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) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 1e489fc..b8bb7cd 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -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 diff --git a/test/test_dev.ml b/test/test_dev.ml index a99a66b..cc32dab 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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 diff --git a/test/test_session.ml b/test/test_session.ml index 9b202a6..8274806 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -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" () diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 3ba4cee..a1332cd 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -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;