338 lines
18 KiB
EmacsLisp
338 lines
18 KiB
EmacsLisp
;;; etaf-resize-benchmark-tests.el --- Resize driver contracts -*- lexical-binding: t; -*-
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'cl-lib)
|
|
(require 'benchmark-ebox-resize)
|
|
|
|
(defmacro etaf-resize-test--with-run (&rest body)
|
|
"Evaluate BODY with isolated evidence and deterministic frame/publication IO."
|
|
(declare (indent 0) (debug t))
|
|
`(let* ((directory (make-temp-file "etaf-resize-test-" t))
|
|
(output (expand-file-name "result.eldata" directory))
|
|
(buffer (generate-new-buffer " *resize-test*"))
|
|
(ebox-resize-benchmark--run nil)
|
|
(ebox-resize-benchmark--last-result nil)
|
|
(ebox--deferred-render-gc-state nil)
|
|
(width 600))
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--guard) #'ignore)
|
|
((symbol-function 'ebox-resize-benchmark--code) (lambda (_) nil))
|
|
((symbol-function 'ebox-native-reflow-runtime-report) #'ignore)
|
|
((symbol-function 'ebox-resize-benchmark--payload)
|
|
(lambda (_buffer) (list :nodes 3 :characters 4 :viewport (list width 24))))
|
|
((symbol-function 'frame-pixel-width) (lambda (&optional _) width))
|
|
((symbol-function 'frame-text-width) (lambda (&optional _) width))
|
|
((symbol-function 'frame-text-height) (lambda (&optional _) 400))
|
|
((symbol-function 'ebox-viewport-window-width) (lambda (_) width))
|
|
((symbol-function 'window-body-height) (lambda (&rest _) 24))
|
|
((symbol-function 'redisplay) #'ignore)
|
|
((symbol-function 'set-frame-size)
|
|
(lambda (_frame new-width _height &optional _) (setq width new-width))))
|
|
,@body)
|
|
(when ebox-resize-benchmark--run
|
|
(ebox-resize-benchmark-cancel))
|
|
(when (buffer-live-p buffer) (kill-buffer buffer))
|
|
(delete-directory directory t))))
|
|
|
|
(defun etaf-resize-test--tick ()
|
|
"Consume the owned driver timer and execute one request synchronously."
|
|
(cancel-timer (plist-get ebox-resize-benchmark--run :timer))
|
|
(ebox-resize-benchmark--next))
|
|
|
|
(ert-deftest etaf-resize-widths-cover-both-endpoints-and-return ()
|
|
"Non-divisible ranges retain their widest point on every sweep."
|
|
(should (equal (ebox-resize-benchmark--widths 400 505 40 2 600)
|
|
'(400 440 480 505 480 440 400 440 480 505 480 440 400 600)))
|
|
(should (equal (ebox-resize-benchmark--widths 400 500 100 1 400)
|
|
'(500 400)))
|
|
(dolist (args '((0 500 1 1 400) (500 400 1 1 400)
|
|
(400 500 0 1 400) (400 500 1 0 400)))
|
|
(should-error (apply #'ebox-resize-benchmark--widths args))))
|
|
|
|
(ert-deftest etaf-resize-completion-keeps-every-publication-and-restores-width ()
|
|
"Only successful publication advances the driver; all samples are retained."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :step 200 :rounds 1 :delay 10 :timeout 20 :output output)
|
|
(let ((planned (plist-get ebox-resize-benchmark--run :planned-count)))
|
|
(dotimes (_ planned)
|
|
(etaf-resize-test--tick)
|
|
(should-not (plist-get ebox-resize-benchmark--run :timer))
|
|
(should (timerp (plist-get ebox-resize-benchmark--run :watchdog)))
|
|
(should (eq :published
|
|
(ebox-resize-benchmark--publication (lambda (&rest _) :published)
|
|
buffer width 24)))
|
|
(should (timerp (plist-get ebox-resize-benchmark--run :timer)))
|
|
(should-not (plist-get ebox-resize-benchmark--run :watchdog)))
|
|
(etaf-resize-test--tick)
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should (= width 600))
|
|
(should (plist-get ebox-resize-benchmark--last-result :valid))
|
|
(should (= planned (plist-get ebox-resize-benchmark--last-result :completed-count)))
|
|
(should (file-exists-p output))
|
|
(should-not (advice-member-p #'ebox-resize-benchmark--publication
|
|
'ebox-rerender-buffer-with-context)))))
|
|
|
|
(ert-deftest etaf-resize-publication-error-and-quit-preserve-cause-and-cleanup ()
|
|
"Original errors and C-g cannot leave advice or timers attached."
|
|
(dolist (failure '((error "original publication failure") (quit "publication interrupted")))
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(let ((watchdog (plist-get ebox-resize-benchmark--run :watchdog)) caught)
|
|
(condition-case condition
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _) (signal (car failure) (cdr failure))) buffer width 24)
|
|
((error quit) (setq caught condition)))
|
|
(should (equal caught failure))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (memq watchdog timer-list))
|
|
(should-not (advice-member-p #'ebox-resize-benchmark--publication
|
|
'ebox-rerender-buffer-with-context))
|
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :completed-count)))
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))))))
|
|
|
|
(ert-deftest etaf-resize-timeout-is-incomplete-and-releases-owned-resources ()
|
|
"No publication must produce failed evidence, never a successful sample."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(let ((watchdog (plist-get ebox-resize-benchmark--run :watchdog)))
|
|
(ebox-resize-benchmark--timeout)
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (memq watchdog timer-list))
|
|
(should (eq 'failed (plist-get ebox-resize-benchmark--last-result :status)))
|
|
(should (= 1 (plist-get ebox-resize-benchmark--last-result :requested-count)))
|
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :completed-count))))))
|
|
|
|
(ert-deftest etaf-resize-report-failure-preserves-publication-failure ()
|
|
"A secondary write failure is visible while the original error survives."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(let (warning)
|
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--write)
|
|
(lambda (&rest _) (error "disk failure")))
|
|
((symbol-function 'message)
|
|
(lambda (format-string &rest args)
|
|
(setq warning (apply #'format format-string args)))))
|
|
(should (equal '(error "original")
|
|
(should-error (ebox-resize-benchmark--abort '(error "original"))))))
|
|
(should (string-match-p "disk failure" warning))
|
|
(should (plist-get ebox-resize-benchmark--last-result :evidence-write-error))
|
|
(should-not ebox-resize-benchmark--run))))
|
|
|
|
(ert-deftest etaf-resize-partial-installation-releases-earlier-phase-advice ()
|
|
"Instrumentation setup failure cleans previously installed advice."
|
|
(etaf-resize-test--with-run
|
|
(let ((original-add (symbol-function 'advice-add)) (calls 0))
|
|
(cl-letf (((symbol-function 'advice-add)
|
|
(lambda (&rest args)
|
|
(if (= 2 (cl-incf calls)) (error "injected install failure")
|
|
(apply original-add args)))))
|
|
(should-error
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20
|
|
:phases '(ebox-viewport-window-width ebox-surface-buffer-revision)
|
|
:output output)))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(let (remaining)
|
|
(advice-mapc (lambda (_fn _props) (setq remaining t)) 'ebox-viewport-window-width)
|
|
(should-not remaining)))))
|
|
|
|
(ert-deftest etaf-resize-mismatched-viewport-cannot-count-as-publication ()
|
|
"A call returning normally is insufficient when published geometry differs."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(should (eq :real-result
|
|
(ebox-resize-benchmark--publication (lambda (&rest _) :real-result)
|
|
buffer (1+ width) 24)))
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :completed-count)))))
|
|
|
|
(ert-deftest etaf-resize-writer-refuses-existing-evidence ()
|
|
"A later invocation must not silently overwrite a previous report."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark--write output '(:original t))
|
|
(should-error (ebox-resize-benchmark--write output '(:replacement t)))
|
|
(with-temp-buffer
|
|
(insert-file-contents output)
|
|
(should (equal '(:original t) (read (current-buffer)))))))
|
|
|
|
(ert-deftest etaf-resize-nested-publication-counts-only-the-outer-call ()
|
|
"Nested public calls belong to the same measured viewport request."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(should
|
|
(eq :outer
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _)
|
|
(ebox-resize-benchmark--publication #'ignore buffer width 24)
|
|
:outer)
|
|
buffer width 24)))
|
|
(should (= 1 (length (plist-get ebox-resize-benchmark--run :samples))))
|
|
(should (timerp (plist-get ebox-resize-benchmark--run :timer)))))
|
|
|
|
(ert-deftest etaf-resize-successful-coverage-without-written-evidence-fails ()
|
|
"Successful calls cannot yield a passed tool result if evidence was lost."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :step 400 :rounds 1
|
|
:delay 10 :timeout 20 :output output)
|
|
(dotimes (_ (plist-get ebox-resize-benchmark--run :planned-count))
|
|
(etaf-resize-test--tick)
|
|
(ebox-resize-benchmark--publication #'ignore buffer width 24))
|
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--write)
|
|
(lambda (&rest _) (error "disk failure")))
|
|
((symbol-function 'message) #'ignore))
|
|
(should-error (etaf-resize-test--tick)))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should (eq 'failed (plist-get ebox-resize-benchmark--last-result :status)))
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :within-limit))
|
|
(should (plist-get ebox-resize-benchmark--last-result :evidence-write-error))))
|
|
|
|
(ert-deftest etaf-resize-unattributed-call-still-executes-product-once ()
|
|
"Diagnostic attribution failure must not prevent real application work."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(ebox-resize-benchmark--publication #'ignore buffer width 24)
|
|
(let ((calls 0))
|
|
(should (eq :real-result
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _) (cl-incf calls) :real-result) buffer width 24)))
|
|
(should (= calls 1))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid)))))
|
|
|
|
(ert-deftest etaf-resize-cancel-from-product-callback-cannot-rearm-run ()
|
|
"Cancellation inside a publication prevents its old callback from rearming."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(should (eq :real-result
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _) (ebox-resize-benchmark-cancel) :real-result)
|
|
buffer width 24)))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should (eq 'cancelled (plist-get ebox-resize-benchmark--last-result :status)))))
|
|
|
|
(ert-deftest etaf-resize-old-publication-cannot-reschedule-replacement-run ()
|
|
"A callback may replace the benchmark; old completion cannot own its timer."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(let (new-run new-timer)
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _)
|
|
(ebox-resize-benchmark-cancel)
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20
|
|
:output (expand-file-name "new.eldata" directory))
|
|
(setq new-run ebox-resize-benchmark--run
|
|
new-timer (plist-get new-run :timer)))
|
|
buffer width 24)
|
|
(should (eq new-run ebox-resize-benchmark--run))
|
|
(should (eq new-timer (plist-get new-run :timer)))
|
|
(should-not (plist-get new-run :samples)))))
|
|
|
|
(ert-deftest etaf-resize-publication-boundary-detects-transient-focus-loss ()
|
|
"Losing focus before publication invalidates it even if the call restores it."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(let (focused)
|
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--guard)
|
|
(lambda () (unless focused (error "lost focus")))))
|
|
(should (eq :real-result
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _) (setq focused t) :real-result) buffer width 24))))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid)))))
|
|
|
|
(ert-deftest etaf-resize-blocking-publication-cannot-hide-expired-deadline ()
|
|
"Completion must check the deadline even if the event loop could not poll it."
|
|
(etaf-resize-test--with-run
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(setf (plist-get (plist-get ebox-resize-benchmark--run :current) :requested-at)
|
|
(- (float-time) 30))
|
|
(should (eq :real-result
|
|
(ebox-resize-benchmark--publication (lambda (&rest _) :real-result)
|
|
buffer width 24)))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
|
(should (> (plist-get (car (plist-get ebox-resize-benchmark--last-result :samples))
|
|
:request-to-published-ms) 20000))))
|
|
|
|
(ert-deftest etaf-resize-code-evidence-includes-every-reload-and-the-driver ()
|
|
"Explicitly loaded modules need evidence even without a sentinel function."
|
|
(let* ((directory (make-temp-file "etaf-resize-code-" t))
|
|
(source (expand-file-name "etaf-resize-evidence-fixture.el" directory))
|
|
(compiled (concat source "c"))
|
|
(features (copy-sequence features)))
|
|
(unwind-protect
|
|
(progn
|
|
(with-temp-file source
|
|
(insert ";;; -*- lexical-binding: t; -*-\n"
|
|
"(provide 'etaf-resize-evidence-fixture)\n"))
|
|
(should (byte-compile-file source))
|
|
(let* ((code (ebox-resize-benchmark--code (list compiled)))
|
|
(reload (car (plist-get code :reload-files)))
|
|
(driver (cl-find 'ebox-resize-benchmark-start (plist-get code :functions)
|
|
:key (lambda (entry) (plist-get entry :function)))))
|
|
(should (featurep 'etaf-resize-evidence-fixture))
|
|
(should (equal (plist-get reload :file) (file-truename compiled)))
|
|
(should (plist-get reload :loaded))
|
|
(should (equal (plist-get reload :sha256)
|
|
(ebox-resize-benchmark--hash-file compiled)))
|
|
(should (equal (plist-get reload :source-sha256)
|
|
(ebox-resize-benchmark--hash-file source)))
|
|
(should (plist-get driver :origin-sha256))))
|
|
(delete-directory directory t))))
|
|
|
|
(ert-deftest etaf-resize-start-waits-for-existing-gc-lease-without-measuring-it ()
|
|
"A preceding render must settle before recording the benchmark baseline."
|
|
(etaf-resize-test--with-run
|
|
(let ((ebox--deferred-render-gc-state '(:busy t))
|
|
(gc-cons-threshold (* 128 1024 1024))
|
|
(gc-cons-percentage .1))
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(etaf-resize-test--tick)
|
|
(should-not (plist-get ebox-resize-benchmark--run :samples))
|
|
(should (= width 600))
|
|
(should (eq :prior-render
|
|
(ebox-resize-benchmark--publication
|
|
(lambda (&rest _) :prior-render) buffer width 24)))
|
|
(setq ebox--deferred-render-gc-state nil gc-cons-threshold (* 16 1024 1024))
|
|
(etaf-resize-test--tick)
|
|
(should (plist-get ebox-resize-benchmark--run :armed))
|
|
(should (= width 400))
|
|
(should (equal (plist-get ebox-resize-benchmark--run :gc-policy)
|
|
(list gc-cons-threshold gc-cons-percentage))))))
|
|
|
|
(ert-deftest etaf-resize-startup-lease-wait-is-bounded ()
|
|
"A stuck preceding render fails without issuing a benchmark resize."
|
|
(etaf-resize-test--with-run
|
|
(let ((ebox--deferred-render-gc-state '(:busy t)))
|
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
|
(setf (plist-get ebox-resize-benchmark--run :ready-deadline) (1- (float-time)))
|
|
(should-error (etaf-resize-test--tick))
|
|
(should (= width 600))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :requested-count))))))
|
|
|
|
(ert-deftest etaf-resize-phase-selection-rejects-the-measurement-machinery ()
|
|
"Instrumentation cannot recursively time its own clock and bookkeeping."
|
|
(etaf-resize-test--with-run
|
|
(dolist (phase '(float-time gethash ebox-resize-benchmark--payload
|
|
ebox-rerender-buffer-with-context))
|
|
(should-error (ebox-resize-benchmark-start buffer 400 800
|
|
:phases (list phase) :output output)))
|
|
(should-not ebox-resize-benchmark--run)
|
|
(should-not (file-exists-p output))))
|
|
|
|
(provide 'etaf-resize-benchmark-tests)
|
|
;;; etaf-resize-benchmark-tests.el ends here
|