diff --git a/etaf-playground.el b/etaf-playground.el index 2429035..14c4ac8 100644 --- a/etaf-playground.el +++ b/etaf-playground.el @@ -84,6 +84,9 @@ frame." ;; keeps byte compilation from treating the protected binding as lexical. (defvar read-eval) +(declare-function ebox-call-with-render-burst + "ebox-buffer-backend" (function &rest arguments)) + (cl-defstruct (etaf-playground-session (:constructor etaf-playground--session-create)) "State shared by one source/preview workspace." @@ -476,13 +479,11 @@ only file evaluated by the framework." (setq-local truncate-lines nil)) buffer) -(defun etaf-playground-mount-example - (buffer-name name &optional session mount-options) - "Mount example NAME into BUFFER-NAME and return its buffer. - -This is the low-level consumer API. `etaf-playground-open-example' adds the -source editors and side-by-side workspace around it. MOUNT-OPTIONS is -forwarded to `etaf-mount', including an optional initial viewport." +(defun etaf-playground--mount-example-now + (buffer-name name session mount-options) + "Build and mount example NAME into BUFFER-NAME. +SESSION supplies authoritative source buffers. MOUNT-OPTIONS is forwarded to +`etaf-mount'. The caller owns the complete framework render burst." (let ((buffer (get-buffer-create buffer-name))) (when-let ((runtime (etaf-runtime-for-buffer buffer))) (with-current-buffer buffer @@ -498,6 +499,19 @@ forwarded to `etaf-mount', including an optional initial viewport." (setq-local etaf-playground-current-example name)) buffer)) +(defun etaf-playground-mount-example + (buffer-name name &optional session mount-options) + "Mount example NAME into BUFFER-NAME and return its buffer. + +This is the low-level consumer API. `etaf-playground-open-example' adds the +source editors and side-by-side workspace around it. MOUNT-OPTIONS is +forwarded to `etaf-mount', including an optional initial viewport. Source +loading, root construction, ETAF publication, and Ebox rendering share one +public framework render burst so GC cannot split an interactive mount." + (ebox-call-with-render-burst + #'etaf-playground--mount-example-now + buffer-name name session mount-options)) + (defun etaf-playground--render-error (session error-data) "Show ERROR-DATA in SESSION's preview buffer after a failed refresh." (let ((buffer (etaf-playground-session-preview-buffer session))) diff --git a/scripts/benchmark-research-shelf.el b/scripts/benchmark-research-shelf.el index 02fd99a..644f71f 100644 --- a/scripts/benchmark-research-shelf.el +++ b/scripts/benchmark-research-shelf.el @@ -75,12 +75,21 @@ never included in SAMPLES. ACTION's result is passed to VERIFY and CLEANUP." (dotimes (index samples) (when setup (funcall setup index)) (garbage-collect) - (pcase-let* ((`(,elapsed . ,result) - (etaf-performance-evaluator--timed-call - (lambda () (funcall action index))))) - (funcall verify result index) - (when cleanup (funcall cleanup result index)) - (push elapsed durations))) + (let (timed) + ;; Interactive Ebox render bursts postpone GC until after visible + ;; completion. A batch burst restores the process threshold + ;; synchronously, which can make the harness collect before its Lisp + ;; caller returns. Stop the timer before restoring that batch-only + ;; threshold; the explicit collection above still settles every run. + (let ((gc-cons-threshold most-positive-fixnum) + (gc-cons-percentage 1.0)) + (setq timed + (etaf-performance-evaluator--timed-call + (lambda () (funcall action index))))) + (pcase-let ((`(,elapsed . ,result) timed)) + (funcall verify result index) + (when cleanup (funcall cleanup result index)) + (push elapsed durations)))) (let ((statistics (etaf-performance-evaluator--statistics (nreverse durations)))) (etaf-performance-evaluator--print-statistics label statistics) diff --git a/tests/benchmark-research-shelf-tests.el b/tests/benchmark-research-shelf-tests.el index ce70e1b..49c188a 100644 --- a/tests/benchmark-research-shelf-tests.el +++ b/tests/benchmark-research-shelf-tests.el @@ -37,6 +37,24 @@ (should (equal '(-1 0 1 2) (nreverse verifications))) (should (= 3 (plist-get (cdr result) :count)))))) +(ert-deftest etaf-performance-evaluator-models-visible-gc-boundary () + "Measured actions defer GC like an interactive Ebox render burst." + (let ((gc-cons-threshold 1000) + (gc-cons-percentage 0.1) + observed) + (etaf-performance-evaluator--measure + "visible-gc-boundary" + (lambda (_index) + (push (list gc-cons-threshold gc-cons-percentage) observed) + t) + (lambda (result _index) (should result)) + :samples 1) + ;; Warmup is intentionally outside the timed visible transaction; the + ;; measured sample owns the raised threshold and caller settings restore. + (should (equal (car observed) (list most-positive-fixnum 1.0))) + (should (= gc-cons-threshold 1000)) + (should (= gc-cons-percentage 0.1)))) + (ert-deftest etaf-performance-evaluator-reports-both-hard-budget-failures () "Report p95 and max independently when both exceed the hard budget." (let ((failures diff --git a/tests/etaf-playground-tests.el b/tests/etaf-playground-tests.el index f7226fc..45194f7 100644 --- a/tests/etaf-playground-tests.el +++ b/tests/etaf-playground-tests.el @@ -100,6 +100,38 @@ database and mounts a test buffer before running BODY." " *etaf-playground-display-order*" "research-shelf")) (should (equal '(display mount) (mapcar #'car (nreverse calls)))))) +(ert-deftest etaf-playground-mount-owns-complete-render-burst () + "Source construction and ETAF mount share the host render transaction." + (let ((buffer " *etaf-playground-burst-test*") + (inside nil) + calls) + (unwind-protect + (cl-letf (((symbol-function 'ebox-call-with-render-burst) + (lambda (function &rest arguments) + (push 'begin calls) + (setq inside t) + (unwind-protect + (prog1 (apply function arguments) + (push 'end calls)) + (setq inside nil)))) + ((symbol-function 'etaf-playground-read-pair) + (lambda (_name _session) + (should inside) + (push 'root calls) + 'test-view)) + ((symbol-function 'etaf-mount) + (lambda (target view options) + (should inside) + (should (equal view 'test-view)) + (should (equal options '(:viewport-width 900))) + (push 'mount calls) + target))) + (should (bufferp + (etaf-playground-mount-example + buffer "test" nil '(:viewport-width 900)))) + (should (equal '(begin root mount end) (nreverse calls)))) + (when (get-buffer buffer) (kill-buffer buffer))))) + (ert-deftest etaf-playground-compile-builds-the-dependency-graph () "Integration builds must compile the framework's dependency graph first." (let ((makefile (with-temp-buffer