diff --git a/scripts/benchmark-research-shelf.el b/scripts/benchmark-research-shelf.el index 968a9b6..81d114c 100644 --- a/scripts/benchmark-research-shelf.el +++ b/scripts/benchmark-research-shelf.el @@ -8,6 +8,7 @@ ;;; Code: (require 'cl-lib) +(require 'json) (require 'seq) (require 'etaf) (require 'etaf-playground) @@ -29,6 +30,18 @@ (defconst etaf-performance-evaluator-viewport-width 1413) (defconst etaf-performance-evaluator-viewport-height 62) +(defconst etaf-performance-evaluator--manifest-scenario-labels + '("prepared-database-mount" "row-selection" "theme-toggle" + "filter-query" "pagination" "progress-mutation" "focus-navigation" + "add-reading" "reload" "viewport-resize" "post-resize-row-selection" + "post-resize-theme-toggle" "post-resize-filter-query" + "post-resize-pagination" "post-resize-add-reading" + "post-resize-reload")) + +(defvar etaf-performance-evaluator--manifest-output nil) +(defvar etaf-performance-evaluator--manifest-scenarios nil) +(defvar etaf-performance-evaluator--manifest-run-id nil) + (defun etaf-performance-evaluator--percentile (samples percentile) "Return nearest-rank PERCENTILE from non-empty numeric SAMPLES." (unless samples (error "Cannot summarize an empty performance sample")) @@ -51,6 +64,70 @@ (plist-get statistics :min) (plist-get statistics :p50) (plist-get statistics :p95) (plist-get statistics :max)))) +(defun etaf-performance-evaluator--record-manifest-sample (label elapsed) + "Record real ELAPSED milliseconds for manifest scenario LABEL. +Recording occurs after the timed action returns and only when the batch +manifest environment enabled evidence capture." + (when (and etaf-performance-evaluator--manifest-scenarios + (member label etaf-performance-evaluator--manifest-scenario-labels)) + (puthash label + (cons elapsed + (gethash label etaf-performance-evaluator--manifest-scenarios)) + etaf-performance-evaluator--manifest-scenarios))) + +(defun etaf-performance-evaluator--manifest-data () + "Return the current raw latency evidence as a JSON-ready object." + (let ((scenarios (make-hash-table :test #'equal))) + (when etaf-performance-evaluator--manifest-scenarios + (maphash + (lambda (label reverse-samples) + (let* ((samples (nreverse (copy-sequence reverse-samples))) + (statistics (etaf-performance-evaluator--statistics samples)) + (record (make-hash-table :test #'equal))) + (puthash "samples_ms" (vconcat samples) record) + (puthash "p95_ms" (plist-get statistics :p95) record) + (puthash "max_ms" (plist-get statistics :max) record) + (puthash label record scenarios))) + etaf-performance-evaluator--manifest-scenarios)) + (let ((manifest (make-hash-table :test #'equal))) + (puthash "schema_version" 1 manifest) + (puthash "kind" "latency-set" manifest) + (puthash "set_index" + (string-to-number (or (getenv "INCREMENTAL_SET_INDEX") "")) + manifest) + (puthash "independent" t manifest) + (puthash "run_id" etaf-performance-evaluator--manifest-run-id manifest) + (puthash "process_id" (emacs-pid) manifest) + (puthash "machine_id" (system-name) manifest) + (puthash "warmups" etaf-performance-evaluator-warmup-count manifest) + (puthash "source_identity" (getenv "INCREMENTAL_SOURCE_IDENTITY") manifest) + (puthash "evaluator_identity" (getenv "INCREMENTAL_EVALUATOR_IDENTITY") manifest) + (puthash "scenarios" scenarios manifest) + manifest))) + +(defun etaf-performance-evaluator--write-manifest () + "Atomically write captured raw samples when manifest output is enabled." + (when etaf-performance-evaluator--manifest-output + (let* ((target (expand-file-name + etaf-performance-evaluator--manifest-output)) + (directory (file-name-directory target)) + temporary) + (make-directory directory t) + (setq temporary (make-temp-file + (expand-file-name ".incremental-perf-" directory) + nil ".json")) + (unwind-protect + (progn + (with-temp-file temporary + (insert (json-serialize + (etaf-performance-evaluator--manifest-data) + :null-object nil :false-object :json-false)) + (insert "\n")) + (rename-file temporary target t) + (setq temporary nil)) + (when (and temporary (file-exists-p temporary)) + (delete-file temporary)))))) + (defun etaf-performance-evaluator--timed-call (function) "Call FUNCTION and return `(ELAPSED-MS . RESULT)'." (let ((started (float-time)) result) @@ -90,6 +167,7 @@ VERIFY and CLEANUP." (etaf-performance-evaluator--timed-call (lambda () (funcall action index))))) (pcase-let ((`(,elapsed . ,result) timed)) + (etaf-performance-evaluator--record-manifest-sample label elapsed) (funcall verify result index) (when cleanup (funcall cleanup result index)) (push elapsed durations)))) @@ -937,12 +1015,30 @@ ETAF generation and preserve RUNTIME's mounted surface in BUFFER." (defun etaf-performance-evaluator-batch () "Batch entry point for the cross-package performance evaluator." - (condition-case condition - (progn (etaf-performance-evaluator-run) (kill-emacs 0)) - (error - (princ (format "PERF-EVALUATOR-ERROR: %s\n" - (error-message-string condition))) - (kill-emacs 1)))) + (let* ((etaf-performance-evaluator--manifest-output + (getenv "INCREMENTAL_PERF_MANIFEST")) + (etaf-performance-evaluator--manifest-scenarios + (and etaf-performance-evaluator--manifest-output + (make-hash-table :test #'equal))) + (etaf-performance-evaluator--manifest-run-id + (and etaf-performance-evaluator--manifest-output + (format "%s-%d-%06x" (format-time-string "%Y%m%dT%H%M%S%N%z") + (emacs-pid) (random #x1000000)))) + (status + (condition-case condition + (progn (etaf-performance-evaluator-run) 0) + (error + (princ (format "PERF-EVALUATOR-ERROR: %s\n" + (error-message-string condition))) + 1)))) + (when etaf-performance-evaluator--manifest-output + (condition-case condition + (etaf-performance-evaluator--write-manifest) + (error + (setq status 1) + (princ (format "PERF-MANIFEST-ERROR: %s\n" + (error-message-string condition)))))) + (kill-emacs status))) (provide 'benchmark-research-shelf) ;;; benchmark-research-shelf.el ends here diff --git a/tests/benchmark-research-shelf-tests.el b/tests/benchmark-research-shelf-tests.el index 7b132be..6529b96 100644 --- a/tests/benchmark-research-shelf-tests.el +++ b/tests/benchmark-research-shelf-tests.el @@ -22,8 +22,19 @@ "../scripts/benchmark-research-shelf") (declare-function etaf-performance-evaluator--measure-overhead "../scripts/benchmark-research-shelf") +(declare-function etaf-performance-evaluator--manifest-data + "../scripts/benchmark-research-shelf") +(declare-function etaf-performance-evaluator--write-manifest + "../scripts/benchmark-research-shelf") +(declare-function etaf-performance-evaluator--record-manifest-sample + "../scripts/benchmark-research-shelf") +(declare-function etaf-performance-evaluator-batch + "../scripts/benchmark-research-shelf") (defvar etaf-performance-evaluator-warmup-count) (defvar etaf-performance-evaluator-sample-count) +(defvar etaf-performance-evaluator--manifest-output) +(defvar etaf-performance-evaluator--manifest-scenarios) +(defvar etaf-performance-evaluator--manifest-run-id) (ert-deftest etaf-performance-evaluator-uses-nearest-rank-percentiles () "Return nearest-rank values for evaluator percentiles." @@ -70,6 +81,109 @@ (should (= gc-cons-threshold 1000)) (should (= gc-cons-percentage 0.1)))) +(ert-deftest etaf-performance-evaluator-manifest-preserves-raw-samples () + "Write exact post-timing samples and statistics to the optional manifest." + (let* ((output (make-temp-file "etaf-perf-manifest-" nil ".json")) + (etaf-performance-evaluator--manifest-output output) + (etaf-performance-evaluator--manifest-scenarios + (make-hash-table :test #'equal)) + (etaf-performance-evaluator--manifest-run-id "unit-run") + (process-environment + (append '("INCREMENTAL_SET_INDEX=2" + "INCREMENTAL_SOURCE_IDENTITY=source-id" + "INCREMENTAL_EVALUATOR_IDENTITY=evaluator-id") + process-environment)) + (durations '(1.25 2.5 3.75))) + (unwind-protect + (progn + (cl-letf (((symbol-function 'etaf-performance-evaluator--timed-call) + (lambda (function) + (cons (pop durations) (funcall function)))) + ((symbol-function 'princ) #'ignore)) + (etaf-performance-evaluator--measure + "row-selection" (lambda (_index) 'ok) + (lambda (result _index) (should (eq result 'ok))) + :warmups 0 :samples 3)) + (etaf-performance-evaluator--write-manifest) + (let* ((json-object-type 'hash-table) + (json-array-type 'list) + (manifest (json-read-file output)) + (scenario (gethash "row-selection" + (gethash "scenarios" manifest)))) + (should (equal '(1.25 2.5 3.75) + (gethash "samples_ms" scenario))) + (should (= 3.75 (gethash "p95_ms" scenario))) + (should (= 3.75 (gethash "max_ms" scenario))) + (should (= 2 (gethash "set_index" manifest))) + (should (equal "source-id" (gethash "source_identity" manifest))) + (should (equal "evaluator-id" + (gethash "evaluator_identity" manifest))))) + (when (file-exists-p output) (delete-file output))))) + +(ert-deftest etaf-performance-evaluator-manifest-retains-failed-prefix () + "Keep only real samples captured before a scenario verification failure." + (let ((etaf-performance-evaluator--manifest-scenarios + (make-hash-table :test #'equal)) + (durations '(4.0 5.0 6.0))) + (cl-letf (((symbol-function 'etaf-performance-evaluator--timed-call) + (lambda (function) + (cons (pop durations) (funcall function)))) + ((symbol-function 'princ) #'ignore)) + (should-error + (etaf-performance-evaluator--measure + "pagination" (lambda (_index) 'ok) + (lambda (_result index) + (when (= index 1) (error "Fixture failure"))) + :warmups 0 :samples 3))) + (should (equal '(5.0 4.0) + (gethash "pagination" + etaf-performance-evaluator--manifest-scenarios))))) + +(ert-deftest etaf-performance-evaluator-batch-writes-manifest-on-failure () + "Write the actually captured prefix before returning a failing batch status." + (let* ((output (make-temp-file "etaf-failed-perf-manifest-" nil ".json")) + (process-environment + (append (list (concat "INCREMENTAL_PERF_MANIFEST=" output) + "INCREMENTAL_SET_INDEX=1" + "INCREMENTAL_SOURCE_IDENTITY=source-id" + "INCREMENTAL_EVALUATOR_IDENTITY=evaluator-id") + process-environment)) + exit-status) + (unwind-protect + (progn + (cl-letf (((symbol-function 'etaf-performance-evaluator-run) + (lambda () + (etaf-performance-evaluator--record-manifest-sample + "filter-query" 8.5) + (error "Fixture failure"))) + ((symbol-function 'kill-emacs) + (lambda (status) (setq exit-status status))) + ((symbol-function 'princ) #'ignore)) + (etaf-performance-evaluator-batch)) + (let* ((json-object-type 'hash-table) + (json-array-type 'list) + (manifest (json-read-file output)) + (scenario (gethash "filter-query" + (gethash "scenarios" manifest)))) + (should (= 1 exit-status)) + (should (equal '(8.5) (gethash "samples_ms" scenario))) + (should (= 8.5 (gethash "p95_ms" scenario))) + (should (= 8.5 (gethash "max_ms" scenario))))) + (when (file-exists-p output) (delete-file output))))) + +(ert-deftest etaf-performance-evaluator-no-manifest-env-keeps-normal-path () + "Do not create evidence or change measurement results without the env opt-in." + (let ((etaf-performance-evaluator--manifest-output nil) + (etaf-performance-evaluator--manifest-scenarios nil)) + (cl-letf (((symbol-function 'princ) #'ignore)) + (let ((result + (etaf-performance-evaluator--measure + "row-selection" (lambda (_index) 'ok) + (lambda (value _index) (should (eq value 'ok))) + :warmups 0 :samples 1))) + (should (= 1 (plist-get (cdr result) :count))))) + (should-not (etaf-performance-evaluator--write-manifest)))) + (ert-deftest etaf-performance-evaluator-reports-both-hard-budget-failures () "Report p95 and max independently when both exceed the hard budget." (let ((failures