From cbbd5122bad2a04d627c7670417219ba8ff21641 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Wed, 26 Aug 2026 00:10:17 +0800 Subject: [PATCH] perf: isolate latency gate from regression load --- Makefile | 4 +++- etaf-playground.el | 20 ++++++++++---------- examples/research-shelf.el | 14 +++++++------- tests/etaf-playground-tests.el | 15 +++++++++++++++ 4 files changed, 35 insertions(+), 18 deletions(-) diff --git a/Makefile b/Makefile index 6465001..629f779 100644 --- a/Makefile +++ b/Makefile @@ -63,9 +63,11 @@ perf-regressions: $(MAKE) -C ../etaf-sqlite test EMACS="$(EMACS)" $(MAKE) test EMACS="$(EMACS)" +# Measure absolute latency before the CPU-heavy regression graph. Regressions +# still gate the same target, but cannot thermally contaminate product samples. perf-check: - $(MAKE) perf-regressions EMACS="$(EMACS)" $(MAKE) perf-evaluator EMACS="$(EMACS)" + $(MAKE) perf-regressions EMACS="$(EMACS)" load: compile $(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-playground))' \ diff --git a/etaf-playground.el b/etaf-playground.el index 14c4ac8..856c91d 100644 --- a/etaf-playground.el +++ b/etaf-playground.el @@ -333,7 +333,7 @@ rejecting executable forms and private runtime heads." (defun etaf-playground--file-content (file session extension) "Return FILE content, preferring SESSION's unsaved EXTENSION buffer." - (if-let ((buffer (etaf-playground--source-buffer session extension))) + (if-let* ((buffer (etaf-playground--source-buffer session extension))) (with-current-buffer buffer (buffer-substring-no-properties (point-min) (point-max))) (with-temp-buffer @@ -485,7 +485,7 @@ only file evaluated by the framework." 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))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) (with-current-buffer buffer (etaf-unmount runtime))) ;; Root factories and lifecycle callbacks are application code. Run them @@ -532,7 +532,7 @@ public framework render burst so GC cannot split an interactive mount." (let ((preview (etaf-playground-session-preview-buffer session))) (condition-case err (progn - (when-let ((runtime (etaf-runtime-for-buffer preview))) + (when-let* ((runtime (etaf-runtime-for-buffer preview))) (with-current-buffer preview (etaf-unmount runtime))) (with-current-buffer preview @@ -644,7 +644,7 @@ the preview instead of destroying the source workspace." " ETAF Source " (mapconcat (lambda (extension) - (when-let ((buffer (etaf-playground--source-buffer + (when-let* ((buffer (etaf-playground--source-buffer session extension))) (let* ((active (equal extension (etaf-playground-session-active-extension @@ -695,7 +695,7 @@ the preview instead of destroying the source workspace." (position (posn-point start))) (when (and (window-live-p window) (integer-or-marker-p position)) (with-current-buffer (window-buffer window) - (when-let ((extension + (when-let* ((extension (get-text-property position 'etaf-playground-extension))) (etaf-playground-switch-source extension)))))) @@ -720,7 +720,7 @@ the preview instead of destroying the source workspace." (defun etaf-playground--source-example-name (&optional buffer) "Return the discovered example name owning BUFFER's source file." - (when-let ((file (buffer-file-name (or buffer (current-buffer))))) + (when-let* ((file (buffer-file-name (or buffer (current-buffer))))) (let ((file (file-truename file))) (cl-loop for spec in etaf-playground-scenario-manifest for name = (plist-get spec :pair) @@ -758,7 +758,7 @@ the preview instead of destroying the source workspace." (user-error "No live ETAF Playground source %s" extension)) (setf (etaf-playground-session-active-extension session) extension) (etaf-playground--refresh-source-headers session) - (when-let ((window (etaf-playground--source-window session))) + (when-let* ((window (etaf-playground--source-window session))) (set-window-buffer window buffer) (select-window window)) buffer)) @@ -955,7 +955,7 @@ default example there." (defun etaf-playground-reset (&optional target) "Refresh TARGET's workspace or remount its direct preview." (interactive) - (if-let ((session (etaf-playground--session-for-target target))) + (if-let* ((session (etaf-playground--session-for-target target))) (etaf-playground-refresh session) (let* ((buffer (cond ((bufferp target) target) ((stringp target) (get-buffer target)) @@ -971,7 +971,7 @@ default example there." (defun etaf-playground-close (&optional target) "Close TARGET's workspace, or unmount and kill a direct preview buffer." (interactive) - (if-let ((session (etaf-playground--session-for-target target))) + (if-let* ((session (etaf-playground--session-for-target target))) (let* ((preview (etaf-playground-session-preview-buffer session)) (preview-window (etaf-playground-session-preview-window session)) @@ -982,7 +982,7 @@ default example there." (window-frame preview-window))) (configuration (etaf-playground-session-previous-window-configuration session))) - (when-let ((runtime (and (buffer-live-p preview) + (when-let* ((runtime (and (buffer-live-p preview) (etaf-runtime-for-buffer preview)))) (with-current-buffer preview (etaf-unmount runtime))) diff --git a/examples/research-shelf.el b/examples/research-shelf.el index 75c8c96..78b9e10 100644 --- a/examples/research-shelf.el +++ b/examples/research-shelf.el @@ -332,7 +332,7 @@ user's prior local additions cannot collide with the generated dataset." (defun etaf-research-shelf--update-selected (model fields message) "Update selected MODEL record with FIELDS and show MESSAGE." - (when-let ((row (etaf-research-shelf--selected model))) + (when-let* ((row (etaf-research-shelf--selected model))) (etaf-research-shelf--mutate model 'update (append (list :id (plist-get row :id)) fields) @@ -387,7 +387,7 @@ user's prior local additions cannot collide with the generated dataset." (etaf-action-define etaf-research-shelf-star (runtime model) "Toggle the selected reading's star." (ignore runtime) - (when-let ((current (etaf-research-shelf--selected model))) + (when-let* ((current (etaf-research-shelf--selected model))) (let ((starred (= 1 (or (plist-get current :starred) 0)))) (etaf-research-shelf--update-selected model (list :starred (if starred 0 1) :updated "Just now") @@ -552,24 +552,24 @@ user's prior local additions cannot collide with the generated dataset." :color (etaf-theme-token :accent)) (text :face 'bold (expr :value - (if-let ((row (etaf-research-shelf--selected model))) + (if-let* ((row (etaf-research-shelf--selected model))) (plist-get row :title) "Choose a record"))) (text :color (etaf-theme-token :muted) (expr :value - (if-let ((row (etaf-research-shelf--selected model))) + (if-let* ((row (etaf-research-shelf--selected model))) (format "%s · %s" (plist-get row :author) (plist-get row :kind)) "Select one row to inspect it."))) (spacer :height 1) (text :face 'bold (expr :value - (if-let ((row (etaf-research-shelf--selected model))) + (if-let* ((row (etaf-research-shelf--selected model))) (etaf-research-shelf--status-label (plist-get row :status)) "○ No selection"))) (text (expr :value - (if-let ((row (etaf-research-shelf--selected model))) + (if-let* ((row (etaf-research-shelf--selected model))) (format "Progress %d%% · Priority %s" (or (plist-get row :progress) 0) (plist-get row :priority)) @@ -584,7 +584,7 @@ user's prior local additions cannot collide with the generated dataset." (spacer :height 1) (text :color (etaf-theme-token :muted) (expr :value - (if-let ((row (etaf-research-shelf--selected model))) + (if-let* ((row (etaf-research-shelf--selected model))) (concat "“" (or (plist-get row :note) "No note yet.") "”") "Your notes and actions will appear here."))) (spacer :height 1) diff --git a/tests/etaf-playground-tests.el b/tests/etaf-playground-tests.el index 1da05d1..449d2f0 100644 --- a/tests/etaf-playground-tests.el +++ b/tests/etaf-playground-tests.el @@ -145,6 +145,21 @@ database and mounts a test buffer before running BODY." "$(MAKE) -C ../etaf-sqlite compile")) (should (string-match-p (regexp-quote dependency) makefile))))) +(ert-deftest etaf-playground-performance-gate-runs-before-regressions () + "CPU-heavy regressions must not contaminate absolute latency samples." + (let* ((makefile (with-temp-buffer + (insert-file-contents "Makefile") + (buffer-string))) + (target (string-match "^perf-check:" makefile)) + (evaluator (and target + (string-match "perf-evaluator" makefile target))) + (regressions (and target + (string-match "perf-regressions" makefile target)))) + (should target) + (should evaluator) + (should regressions) + (should (< evaluator regressions)))) + (ert-deftest etaf-playground-static-reader-is-inert-and-strict () "Read pair structure as inert data and reject executable AST nodes." (let* ((form (etaf-playground-read-static "research-shelf"))