test: add fail-closed Emacs GUI scenario engine
This commit is contained in:
Kinneyzhang
parent
e9323ef700
commit
0b254c1ff2
12
Makefile
12
Makefile
@ -1,8 +1,8 @@
|
|||||||
EMACS ?= emacs
|
EMACS ?= emacs
|
||||||
LOAD_PATH = -L . -L examples -L ../ebox -L ../tp -L ../ecss
|
LOAD_PATH = -L . -L examples -L scripts -L ../ebox -L ../tp -L ../ecss
|
||||||
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el
|
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el scripts/emacs-gui-verifier.el
|
||||||
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
|
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
|
||||||
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el
|
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el
|
||||||
|
|
||||||
.PHONY: test compile load checkdoc docs-check check clean
|
.PHONY: test compile load checkdoc docs-check check clean
|
||||||
|
|
||||||
@ -13,7 +13,7 @@ test: compile
|
|||||||
|
|
||||||
compile: clean
|
compile: clean
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) \
|
$(EMACS) -Q --batch $(LOAD_PATH) \
|
||||||
--eval "(setq load-prefer-newer t)" \
|
--eval "(setq load-prefer-newer t byte-compile-error-on-warn t byte-compile-warnings '(not obsolete))" \
|
||||||
--eval "(load-file \"etaf.el\")" \
|
--eval "(load-file \"etaf.el\")" \
|
||||||
--eval "(dolist (file '($(foreach file,$(SOURCES) $(EXAMPLES),\"$(file)\"))) (byte-compile-file file))"
|
--eval "(dolist (file '($(foreach file,$(SOURCES) $(EXAMPLES),\"$(file)\"))) (byte-compile-file file))"
|
||||||
|
|
||||||
@ -25,9 +25,9 @@ docs-check:
|
|||||||
-f ert-run-tests-batch-and-exit
|
-f ert-run-tests-batch-and-exit
|
||||||
|
|
||||||
checkdoc:
|
checkdoc:
|
||||||
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (directory (list "." "examples")) (dolist (file (directory-files directory t)) (when (string-suffix-p ".el" file) (checkdoc-file file)))))'
|
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (directory (list "." "examples" "scripts")) (dolist (file (directory-files directory t)) (when (string-suffix-p ".el" file) (checkdoc-file file)))))'
|
||||||
|
|
||||||
check: checkdoc compile test docs-check
|
check: checkdoc compile test docs-check
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f *.elc examples/*.elc tests/*.elc
|
rm -f *.elc examples/*.elc scripts/*.elc tests/*.elc
|
||||||
|
|||||||
31
scripts/README.md
Normal file
31
scripts/README.md
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
# Generic Emacs GUI verification
|
||||||
|
|
||||||
|
This directory owns the reusable verification mechanism, not application
|
||||||
|
scenarios:
|
||||||
|
|
||||||
|
- `emacs-gui-verifier.el` defines `Scenario`, ordered `Action`, run-local
|
||||||
|
`Context`, checkpoint sequencing, assertions, completion, and fail-closed
|
||||||
|
evidence finalization.
|
||||||
|
- `run-emacs-gui-verification.sh` owns one named daemon, explicit load paths,
|
||||||
|
external application activation, recorder lifecycle, driver loading, report
|
||||||
|
generation, and exact cleanup.
|
||||||
|
- `record-screen.exp` keeps macOS `screencapture -v` attached to a PTY and stops
|
||||||
|
it through an explicit signal. It contains no Emacs or application logic.
|
||||||
|
|
||||||
|
Concrete repositories provide adapter files that construct a Scenario and an
|
||||||
|
entry function. The generic command is:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
scripts/run-emacs-gui-verification.sh run ADAPTER.el ENTRY \
|
||||||
|
--load-path /path/to/provider \
|
||||||
|
--run-dir /private/tmp/my-gui-run
|
||||||
|
```
|
||||||
|
|
||||||
|
Fresh captures intentionally remain `INCOMPLETE` until their selected images
|
||||||
|
and contact sheet are reviewed. Finalize the same evidence directory with:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
scripts/run-emacs-gui-verification.sh review /private/tmp/my-gui-run
|
||||||
|
```
|
||||||
|
|
||||||
|
Only `VERDICT=PASS` is completion evidence.
|
||||||
198
scripts/emacs-gui-verifier.el
Normal file
198
scripts/emacs-gui-verifier.el
Normal file
@ -0,0 +1,198 @@
|
|||||||
|
;;; emacs-gui-verifier.el --- Generic temporal GUI scenario engine -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; This developer tool executes declarative GUI scenarios against any Emacs
|
||||||
|
;; buffer. It owns action ordering, checkpoint phases, target-buffer guards,
|
||||||
|
;; completion, and evidence lifecycle. It does not know ETAF Runtime, Ebox,
|
||||||
|
;; Playground, or any concrete example; adapters supply those facts through
|
||||||
|
;; callbacks and opaque context data.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
|
||||||
|
(declare-function emacs-dynamic-ui-verification-start
|
||||||
|
"capture-checkpoint" (directory run-id claim required-phases))
|
||||||
|
(declare-function emacs-dynamic-ui-verification-checkpoint
|
||||||
|
"capture-checkpoint"
|
||||||
|
(action-id phase adapter assertions screenshot))
|
||||||
|
(declare-function emacs-dynamic-ui-verification-finish
|
||||||
|
"capture-checkpoint" (completed adapter))
|
||||||
|
|
||||||
|
(cl-defstruct (etaf-gui-verifier-action
|
||||||
|
(:constructor etaf-gui-verifier-action-create))
|
||||||
|
"One ordered GUI action and its postcondition callback."
|
||||||
|
id execute assertions screenshot settled-p
|
||||||
|
(settle-timeout 5.0) (settle-interval 0.05))
|
||||||
|
|
||||||
|
(cl-defstruct (etaf-gui-verifier-scenario
|
||||||
|
(:constructor etaf-gui-verifier-scenario-create))
|
||||||
|
"One reusable GUI scenario assembled by an adapter."
|
||||||
|
name claim initialize actions invariants adapter completion)
|
||||||
|
|
||||||
|
(cl-defstruct (etaf-gui-verifier-context
|
||||||
|
(:constructor etaf-gui-verifier--context-create))
|
||||||
|
"Mutable execution state owned only by one verifier run."
|
||||||
|
scenario target-buffer data (action-count 0) (last-duration-ms 0.0))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier-context-put (context key value)
|
||||||
|
"Store adapter VALUE for KEY in CONTEXT and return VALUE."
|
||||||
|
(setf (alist-get key (etaf-gui-verifier-context-data context)) value)
|
||||||
|
value)
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier-context-get (context key &optional default)
|
||||||
|
"Return CONTEXT adapter value KEY, or DEFAULT when absent."
|
||||||
|
(alist-get key (etaf-gui-verifier-context-data context) default))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier-context-select-buffer (context buffer)
|
||||||
|
"Select live BUFFER as CONTEXT's single-window target."
|
||||||
|
(unless (buffer-live-p buffer)
|
||||||
|
(error "GUI verifier target buffer is not live"))
|
||||||
|
(setf (etaf-gui-verifier-context-target-buffer context) buffer)
|
||||||
|
(switch-to-buffer buffer)
|
||||||
|
(delete-other-windows)
|
||||||
|
buffer)
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier-assert (name passed &optional detail)
|
||||||
|
"Return one normalized assertion NAME for PASSED and optional DETAIL."
|
||||||
|
(append (list (cons 'name name) (cons 'passed (and passed t)))
|
||||||
|
(when detail (list (cons 'detail detail)))))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier--target-assertions (context)
|
||||||
|
"Return generic selected-target assertions for CONTEXT."
|
||||||
|
(let ((buffer (etaf-gui-verifier-context-target-buffer context)))
|
||||||
|
(list
|
||||||
|
(etaf-gui-verifier-assert
|
||||||
|
"target-buffer-selected"
|
||||||
|
(and (buffer-live-p buffer)
|
||||||
|
(eq (window-buffer (selected-window)) buffer))))))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier--scenario-assertions (context)
|
||||||
|
"Return generic and adapter assertions for CONTEXT."
|
||||||
|
(let* ((scenario (etaf-gui-verifier-context-scenario context))
|
||||||
|
(function (etaf-gui-verifier-scenario-invariants scenario)))
|
||||||
|
(append
|
||||||
|
(etaf-gui-verifier--target-assertions context)
|
||||||
|
(and function (funcall function context)))))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier--adapter-data (context)
|
||||||
|
"Return generic and adapter JSON data for CONTEXT."
|
||||||
|
(let* ((scenario (etaf-gui-verifier-context-scenario context))
|
||||||
|
(function (etaf-gui-verifier-scenario-adapter scenario)))
|
||||||
|
(append
|
||||||
|
(list
|
||||||
|
(cons 'scenario (etaf-gui-verifier-scenario-name scenario))
|
||||||
|
(cons 'action_count
|
||||||
|
(etaf-gui-verifier-context-action-count context))
|
||||||
|
(cons 'duration_ms
|
||||||
|
(etaf-gui-verifier-context-last-duration-ms context)))
|
||||||
|
(and function (funcall function context)))))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier--checkpoint
|
||||||
|
(context action-id phase screenshot &optional extra)
|
||||||
|
"Capture CONTEXT ACTION-ID PHASE with SCREENSHOT and EXTRA assertions."
|
||||||
|
(emacs-dynamic-ui-verification-checkpoint
|
||||||
|
action-id phase
|
||||||
|
(etaf-gui-verifier--adapter-data context)
|
||||||
|
(append (etaf-gui-verifier--scenario-assertions context) extra)
|
||||||
|
screenshot))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier--settle-action (context action)
|
||||||
|
"Wait until ACTION's visible result is settled in CONTEXT."
|
||||||
|
(let ((settled-p (etaf-gui-verifier-action-settled-p action))
|
||||||
|
(timeout (etaf-gui-verifier-action-settle-timeout action))
|
||||||
|
(interval (etaf-gui-verifier-action-settle-interval action)))
|
||||||
|
(unless settled-p
|
||||||
|
(error "GUI action has no settle predicate: %s"
|
||||||
|
(etaf-gui-verifier-action-id action)))
|
||||||
|
(unless (and (numberp timeout) (> timeout 0))
|
||||||
|
(error "GUI action settle timeout must be positive: %s"
|
||||||
|
(etaf-gui-verifier-action-id action)))
|
||||||
|
(unless (and (numberp interval) (> interval 0))
|
||||||
|
(error "GUI action settle interval must be positive: %s"
|
||||||
|
(etaf-gui-verifier-action-id action)))
|
||||||
|
;; Always complete at least one redisplay before accepting a predicate.
|
||||||
|
;; A predicate proves adapter state, not that Emacs painted that state.
|
||||||
|
(redisplay t)
|
||||||
|
(sit-for 0)
|
||||||
|
(let ((deadline
|
||||||
|
(+ (float-time) timeout))
|
||||||
|
settled)
|
||||||
|
(while (not settled)
|
||||||
|
(when (>= (float-time) deadline)
|
||||||
|
(error "GUI action did not settle before timeout: %s"
|
||||||
|
(etaf-gui-verifier-action-id action)))
|
||||||
|
(if (funcall settled-p context)
|
||||||
|
;; Require the same postcondition across one event/paint turn.
|
||||||
|
;; Runtime state can be synchronous while the GUI compositor still
|
||||||
|
;; presents the preceding frame.
|
||||||
|
(progn
|
||||||
|
(sit-for interval)
|
||||||
|
(redisplay t)
|
||||||
|
(setq settled (funcall settled-p context)))
|
||||||
|
(sit-for interval)
|
||||||
|
(redisplay t))))))
|
||||||
|
|
||||||
|
(defun etaf-gui-verifier--run-action (context action)
|
||||||
|
"Execute ACTION once inside CONTEXT's ordered checkpoint protocol."
|
||||||
|
(let ((action-id (etaf-gui-verifier-action-id action))
|
||||||
|
(assertions (etaf-gui-verifier-action-assertions action)))
|
||||||
|
(etaf-gui-verifier--checkpoint
|
||||||
|
context action-id "before-action" nil)
|
||||||
|
(let ((started (float-time)))
|
||||||
|
(funcall (etaf-gui-verifier-action-execute action) context)
|
||||||
|
(setf (etaf-gui-verifier-context-last-duration-ms context)
|
||||||
|
(* 1000.0 (- (float-time) started))))
|
||||||
|
(cl-incf (etaf-gui-verifier-context-action-count context))
|
||||||
|
(etaf-gui-verifier--checkpoint
|
||||||
|
context action-id "after-action" nil)
|
||||||
|
(raise-frame)
|
||||||
|
(etaf-gui-verifier--settle-action context action)
|
||||||
|
(etaf-gui-verifier--checkpoint
|
||||||
|
context action-id "after-redisplay"
|
||||||
|
(etaf-gui-verifier-action-screenshot action)
|
||||||
|
(and assertions (funcall assertions context)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun etaf-gui-verifier-run (scenario run-directory)
|
||||||
|
"Execute generic SCENARIO and write temporal evidence to RUN-DIRECTORY."
|
||||||
|
(unless (etaf-gui-verifier-scenario-p scenario)
|
||||||
|
(signal 'wrong-type-argument
|
||||||
|
(list 'etaf-gui-verifier-scenario-p scenario)))
|
||||||
|
(let* ((context
|
||||||
|
(etaf-gui-verifier--context-create :scenario scenario))
|
||||||
|
(initialize (etaf-gui-verifier-scenario-initialize scenario))
|
||||||
|
(completion (etaf-gui-verifier-scenario-completion scenario))
|
||||||
|
finished-p)
|
||||||
|
(emacs-dynamic-ui-verification-start
|
||||||
|
run-directory
|
||||||
|
(etaf-gui-verifier-scenario-name scenario)
|
||||||
|
(etaf-gui-verifier-scenario-claim scenario)
|
||||||
|
'("before-action" "after-action" "after-redisplay"))
|
||||||
|
(condition-case error-data
|
||||||
|
(progn
|
||||||
|
(when initialize (funcall initialize context))
|
||||||
|
(dolist (action (etaf-gui-verifier-scenario-actions scenario))
|
||||||
|
(etaf-gui-verifier--run-action context action))
|
||||||
|
(let ((completed (if completion
|
||||||
|
(funcall completion context)
|
||||||
|
t)))
|
||||||
|
(emacs-dynamic-ui-verification-finish
|
||||||
|
completed (etaf-gui-verifier--adapter-data context))
|
||||||
|
(setq finished-p t)
|
||||||
|
(unless completed
|
||||||
|
(error "GUI scenario completion predicate failed")))
|
||||||
|
context)
|
||||||
|
((error quit)
|
||||||
|
(unless finished-p
|
||||||
|
(condition-case finish-error
|
||||||
|
(emacs-dynamic-ui-verification-finish
|
||||||
|
nil (etaf-gui-verifier--adapter-data context))
|
||||||
|
(error
|
||||||
|
(message "GUI verifier could not record failed completion: %s"
|
||||||
|
(error-message-string finish-error)))))
|
||||||
|
(signal (car error-data) (cdr error-data))))))
|
||||||
|
|
||||||
|
(provide 'emacs-gui-verifier)
|
||||||
|
;;; emacs-gui-verifier.el ends here
|
||||||
31
scripts/record-screen.exp
Executable file
31
scripts/record-screen.exp
Executable file
@ -0,0 +1,31 @@
|
|||||||
|
#!/usr/bin/expect -f
|
||||||
|
|
||||||
|
# Keep macOS screencapture attached to a real PTY. Redirecting its stdin to
|
||||||
|
# /dev/null makes current macOS builds stop recording immediately.
|
||||||
|
|
||||||
|
set maximum_seconds 600
|
||||||
|
|
||||||
|
if {$argc != 1} {
|
||||||
|
puts stderr "usage: record-screen.exp OUTPUT"
|
||||||
|
exit 2
|
||||||
|
}
|
||||||
|
|
||||||
|
set output [lindex $argv 0]
|
||||||
|
spawn -noecho /usr/sbin/screencapture -v -D 1 -x $output
|
||||||
|
set deadline [expr {[clock seconds] + $maximum_seconds}]
|
||||||
|
|
||||||
|
trap {
|
||||||
|
send -- "q"
|
||||||
|
expect eof
|
||||||
|
exit 0
|
||||||
|
} {SIGTERM SIGINT}
|
||||||
|
|
||||||
|
while {1} {
|
||||||
|
after 1000
|
||||||
|
if {[clock seconds] >= $deadline} {
|
||||||
|
send -- "q"
|
||||||
|
expect eof
|
||||||
|
puts stderr "screen recording exceeded $maximum_seconds seconds"
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
}
|
||||||
330
scripts/run-emacs-gui-verification.sh
Executable file
330
scripts/run-emacs-gui-verification.sh
Executable file
@ -0,0 +1,330 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
set -eu
|
||||||
|
|
||||||
|
GUI_CORE_SCRIPT_DIR=$(CDPATH= cd "$(dirname "$0")" && pwd)
|
||||||
|
GUI_ENGINE="$GUI_CORE_SCRIPT_DIR/emacs-gui-verifier.el"
|
||||||
|
GUI_RECORDER="$GUI_CORE_SCRIPT_DIR/record-screen.exp"
|
||||||
|
GUI_EMACS_APP=${EMACS_APP:-/Applications/Emacs.app}
|
||||||
|
GUI_EMACS_BIN="$GUI_EMACS_APP/Contents/MacOS/Emacs"
|
||||||
|
GUI_EMACSCLIENT="$GUI_EMACS_APP/Contents/MacOS/bin/emacsclient"
|
||||||
|
GUI_EMACS_APP_NAME=${EMACS_APP_NAME:-Emacs}
|
||||||
|
GUI_CODEX_ROOT=${CODEX_HOME:-${HOME}/.codex}
|
||||||
|
GUI_DYNAMIC_SKILL=${EMACS_DYNAMIC_UI_SKILL_DIR:-$GUI_CODEX_ROOT/skills/emacs-dynamic-ui-verification}
|
||||||
|
GUI_CHECKPOINT_EL="$GUI_DYNAMIC_SKILL/scripts/capture-checkpoint.el"
|
||||||
|
GUI_EVIDENCE_PY="$GUI_DYNAMIC_SKILL/scripts/evidence.py"
|
||||||
|
|
||||||
|
usage() {
|
||||||
|
echo "usage:" >&2
|
||||||
|
echo " $0 doctor" >&2
|
||||||
|
echo " $0 review RUN_DIR" >&2
|
||||||
|
echo " $0 run ADAPTER_EL ENTRY_FUNCTION [--run-dir DIR] [--load-path DIR]..." >&2
|
||||||
|
exit 2
|
||||||
|
}
|
||||||
|
|
||||||
|
require_file() {
|
||||||
|
[ -f "$1" ] || {
|
||||||
|
echo "required file is missing: $1" >&2
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
doctor() {
|
||||||
|
require_file "$GUI_EMACS_BIN"
|
||||||
|
require_file "$GUI_EMACSCLIENT"
|
||||||
|
require_file "$GUI_ENGINE"
|
||||||
|
require_file "$GUI_RECORDER"
|
||||||
|
require_file "$GUI_CHECKPOINT_EL"
|
||||||
|
require_file "$GUI_EVIDENCE_PY"
|
||||||
|
command -v osascript >/dev/null 2>&1
|
||||||
|
command -v expect >/dev/null 2>&1
|
||||||
|
command -v ffmpeg >/dev/null 2>&1
|
||||||
|
command -v python3 >/dev/null 2>&1
|
||||||
|
echo "EMACS-GUI-VERIFIER DOCTOR PASS"
|
||||||
|
}
|
||||||
|
|
||||||
|
review_run() {
|
||||||
|
[ "$#" -eq 1 ] || usage
|
||||||
|
GUI_REVIEW_DIR=$1
|
||||||
|
require_file "$GUI_REVIEW_DIR/manifest.jsonl"
|
||||||
|
require_file "$GUI_REVIEW_DIR/recording.mov"
|
||||||
|
python3 "$GUI_EVIDENCE_PY" finalize \
|
||||||
|
--run-dir "$GUI_REVIEW_DIR" --temporal-reviewed
|
||||||
|
}
|
||||||
|
|
||||||
|
GUI_DAEMON=""
|
||||||
|
GUI_DAEMON_PID=""
|
||||||
|
GUI_RECORDER_PID=""
|
||||||
|
GUI_RECORDER_CHILD_PID=""
|
||||||
|
GUI_DAEMON_STARTED=false
|
||||||
|
|
||||||
|
valid_pid() {
|
||||||
|
case $1 in
|
||||||
|
''|*[!0-9]*) return 1 ;;
|
||||||
|
*) [ "$1" -gt 1 ] ;;
|
||||||
|
esac
|
||||||
|
}
|
||||||
|
|
||||||
|
process_alive() {
|
||||||
|
valid_pid "$1" && kill -0 "$1" 2>/dev/null
|
||||||
|
}
|
||||||
|
|
||||||
|
wait_for_exit() {
|
||||||
|
GUI_WAIT_PID=$1
|
||||||
|
GUI_WAIT_LIMIT=$2
|
||||||
|
GUI_WAIT_ATTEMPT=0
|
||||||
|
while process_alive "$GUI_WAIT_PID"; do
|
||||||
|
[ "$GUI_WAIT_ATTEMPT" -lt "$GUI_WAIT_LIMIT" ] || return 1
|
||||||
|
sleep 0.1
|
||||||
|
GUI_WAIT_ATTEMPT=$((GUI_WAIT_ATTEMPT + 1))
|
||||||
|
done
|
||||||
|
}
|
||||||
|
|
||||||
|
force_owned_exit() {
|
||||||
|
GUI_FORCE_PID=$1
|
||||||
|
GUI_FORCE_LABEL=$2
|
||||||
|
process_alive "$GUI_FORCE_PID" || return 0
|
||||||
|
echo "forcing owned $GUI_FORCE_LABEL process to exit: $GUI_FORCE_PID" >&2
|
||||||
|
kill -TERM "$GUI_FORCE_PID" 2>/dev/null || return 1
|
||||||
|
if ! wait_for_exit "$GUI_FORCE_PID" 20; then
|
||||||
|
kill -KILL "$GUI_FORCE_PID" 2>/dev/null || return 1
|
||||||
|
wait_for_exit "$GUI_FORCE_PID" 10 || return 1
|
||||||
|
fi
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
|
||||||
|
stop_recorder() {
|
||||||
|
[ -n "$GUI_RECORDER_PID" ] || return 0
|
||||||
|
GUI_RECORDER_STOP_FAILED=0
|
||||||
|
if process_alive "$GUI_RECORDER_PID"; then
|
||||||
|
if ! kill -TERM "$GUI_RECORDER_PID"; then
|
||||||
|
GUI_RECORDER_STOP_FAILED=1
|
||||||
|
elif ! wait_for_exit "$GUI_RECORDER_PID" 50; then
|
||||||
|
GUI_RECORDER_STOP_FAILED=1
|
||||||
|
if ! force_owned_exit "$GUI_RECORDER_PID" "recorder wrapper"; then
|
||||||
|
GUI_RECORDER_STOP_FAILED=1
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
if process_alive "$GUI_RECORDER_CHILD_PID"; then
|
||||||
|
GUI_RECORDER_STOP_FAILED=1
|
||||||
|
if ! force_owned_exit "$GUI_RECORDER_CHILD_PID" "screen recorder"; then
|
||||||
|
GUI_RECORDER_STOP_FAILED=1
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
if ! wait "$GUI_RECORDER_PID" 2>/dev/null; then
|
||||||
|
GUI_RECORDER_STOP_FAILED=1
|
||||||
|
fi
|
||||||
|
GUI_RECORDER_PID=""
|
||||||
|
GUI_RECORDER_CHILD_PID=""
|
||||||
|
[ "$GUI_RECORDER_STOP_FAILED" -eq 0 ]
|
||||||
|
}
|
||||||
|
|
||||||
|
stop_daemon() {
|
||||||
|
[ "$GUI_DAEMON_STARTED" = true ] || return 0
|
||||||
|
GUI_DAEMON_STOP_FAILED=0
|
||||||
|
if ! "$GUI_EMACSCLIENT" -n -s "$GUI_DAEMON" -e '(kill-emacs 0)' \
|
||||||
|
>"$GUI_RUN_DIR/daemon-shutdown.log" 2>&1; then
|
||||||
|
GUI_DAEMON_STOP_FAILED=1
|
||||||
|
fi
|
||||||
|
if ! wait_for_exit "$GUI_DAEMON_PID" 50; then
|
||||||
|
GUI_DAEMON_STOP_FAILED=1
|
||||||
|
if ! force_owned_exit "$GUI_DAEMON_PID" "Emacs daemon"; then
|
||||||
|
GUI_DAEMON_STOP_FAILED=1
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
GUI_DAEMON_STARTED=false
|
||||||
|
GUI_DAEMON_PID=""
|
||||||
|
GUI_DAEMON=""
|
||||||
|
[ "$GUI_DAEMON_STOP_FAILED" -eq 0 ]
|
||||||
|
}
|
||||||
|
|
||||||
|
cleanup() {
|
||||||
|
GUI_CLEANUP_FAILED=0
|
||||||
|
if ! stop_recorder; then
|
||||||
|
echo "GUI recorder cleanup failed" >&2
|
||||||
|
GUI_CLEANUP_FAILED=1
|
||||||
|
fi
|
||||||
|
if ! stop_daemon; then
|
||||||
|
echo "GUI daemon cleanup failed" >&2
|
||||||
|
GUI_CLEANUP_FAILED=1
|
||||||
|
fi
|
||||||
|
[ "$GUI_CLEANUP_FAILED" -eq 0 ]
|
||||||
|
}
|
||||||
|
|
||||||
|
on_exit() {
|
||||||
|
GUI_MAIN_STATUS=$?
|
||||||
|
trap - EXIT HUP INT TERM
|
||||||
|
if ! cleanup; then
|
||||||
|
[ "$GUI_MAIN_STATUS" -ne 0 ] || GUI_MAIN_STATUS=1
|
||||||
|
fi
|
||||||
|
exit "$GUI_MAIN_STATUS"
|
||||||
|
}
|
||||||
|
|
||||||
|
trap on_exit EXIT
|
||||||
|
trap 'exit 130' HUP INT TERM
|
||||||
|
|
||||||
|
activate_emacs() {
|
||||||
|
osascript -e "tell application \"$GUI_EMACS_APP_NAME\" to activate"
|
||||||
|
GUI_ACTIVATE_ATTEMPTS=0
|
||||||
|
while [ "$GUI_ACTIVATE_ATTEMPTS" -lt 30 ]; do
|
||||||
|
GUI_FRONTMOST=$(osascript -e \
|
||||||
|
'tell application "System Events" to get name of first application process whose frontmost is true')
|
||||||
|
case $GUI_FRONTMOST in
|
||||||
|
*Emacs*)
|
||||||
|
sleep 0.2
|
||||||
|
return 0
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
sleep 0.1
|
||||||
|
GUI_ACTIVATE_ATTEMPTS=$((GUI_ACTIVATE_ATTEMPTS + 1))
|
||||||
|
done
|
||||||
|
echo "Emacs did not become the frontmost application" >&2
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
|
||||||
|
start_recorder() {
|
||||||
|
/usr/bin/expect "$GUI_RECORDER" "$GUI_RUN_DIR/recording.mov" \
|
||||||
|
>"$GUI_RUN_DIR/recorder.log" 2>&1 &
|
||||||
|
GUI_RECORDER_PID=$!
|
||||||
|
GUI_RECORDER_ATTEMPTS=0
|
||||||
|
while [ "$GUI_RECORDER_ATTEMPTS" -lt 30 ]; do
|
||||||
|
if ! kill -0 "$GUI_RECORDER_PID" 2>/dev/null; then
|
||||||
|
echo "screen recorder exited before the scenario started" >&2
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
GUI_RECORDER_CHILD_PID=$(
|
||||||
|
pgrep -P "$GUI_RECORDER_PID" -x screencapture 2>/dev/null |
|
||||||
|
sed -n '1p'
|
||||||
|
)
|
||||||
|
if process_alive "$GUI_RECORDER_CHILD_PID"; then
|
||||||
|
return 0
|
||||||
|
fi
|
||||||
|
sleep 0.1
|
||||||
|
GUI_RECORDER_ATTEMPTS=$((GUI_RECORDER_ATTEMPTS + 1))
|
||||||
|
done
|
||||||
|
echo "screen recorder did not create its PTY child" >&2
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
|
||||||
|
parse_run_arguments() {
|
||||||
|
[ "$#" -ge 2 ] || usage
|
||||||
|
GUI_ADAPTER=$1
|
||||||
|
GUI_ENTRY=$2
|
||||||
|
shift 2
|
||||||
|
GUI_RUN_DIR=""
|
||||||
|
GUI_LOAD_PATHS=""
|
||||||
|
while [ "$#" -gt 0 ]; do
|
||||||
|
case $1 in
|
||||||
|
--run-dir)
|
||||||
|
[ "$#" -ge 2 ] || usage
|
||||||
|
GUI_RUN_DIR=$2
|
||||||
|
shift 2
|
||||||
|
;;
|
||||||
|
--load-path)
|
||||||
|
[ "$#" -ge 2 ] || usage
|
||||||
|
case $2 in *:*)
|
||||||
|
echo "load path cannot contain a colon: $2" >&2
|
||||||
|
exit 1
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
if [ -n "$GUI_LOAD_PATHS" ]; then
|
||||||
|
GUI_LOAD_PATHS="$GUI_LOAD_PATHS:$2"
|
||||||
|
else
|
||||||
|
GUI_LOAD_PATHS=$2
|
||||||
|
fi
|
||||||
|
shift 2
|
||||||
|
;;
|
||||||
|
*) usage ;;
|
||||||
|
esac
|
||||||
|
done
|
||||||
|
require_file "$GUI_ADAPTER"
|
||||||
|
if [ -z "$GUI_RUN_DIR" ]; then
|
||||||
|
GUI_RUN_DIR=$(mktemp -d /private/tmp/emacs-gui-verification.XXXXXX)
|
||||||
|
else
|
||||||
|
mkdir -p "$GUI_RUN_DIR"
|
||||||
|
fi
|
||||||
|
if [ -e "$GUI_RUN_DIR/manifest.jsonl" ] || [ -e "$GUI_RUN_DIR/recording.mov" ]; then
|
||||||
|
echo "run directory already contains GUI evidence: $GUI_RUN_DIR" >&2
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
}
|
||||||
|
|
||||||
|
run_adapter() {
|
||||||
|
doctor >/dev/null
|
||||||
|
export ETAF_GUI_RUN_DIR="$GUI_RUN_DIR"
|
||||||
|
export ETAF_GUI_LOAD_PATHS="$GUI_LOAD_PATHS"
|
||||||
|
export ETAF_GUI_ENTRY="$GUI_ENTRY"
|
||||||
|
GUI_DAEMON="emacs-gui-verify-$$"
|
||||||
|
"$GUI_EMACS_BIN" -Q --daemon="$GUI_DAEMON" \
|
||||||
|
--eval '(setq native-comp-jit-compilation nil load-prefer-newer t)'
|
||||||
|
GUI_DAEMON_STARTED=true
|
||||||
|
GUI_DAEMON_PID=$(
|
||||||
|
"$GUI_EMACSCLIENT" -n -s "$GUI_DAEMON" -e '(emacs-pid)'
|
||||||
|
)
|
||||||
|
valid_pid "$GUI_DAEMON_PID" || {
|
||||||
|
echo "Emacs daemon returned an invalid process id: $GUI_DAEMON_PID" >&2
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
"$GUI_EMACSCLIENT" -n -s "$GUI_DAEMON" -c -e \
|
||||||
|
"(progn
|
||||||
|
(dolist (path (split-string (or (getenv \"ETAF_GUI_LOAD_PATHS\") \"\") path-separator t))
|
||||||
|
(add-to-list 'load-path path))
|
||||||
|
(load \"$GUI_CHECKPOINT_EL\" nil nil t)
|
||||||
|
(load \"$GUI_ENGINE\" nil nil t)
|
||||||
|
(load \"$GUI_ADAPTER\" nil nil t)
|
||||||
|
(when (fboundp 'tool-bar-mode) (tool-bar-mode -1))
|
||||||
|
(when (fboundp 'menu-bar-mode) (menu-bar-mode -1))
|
||||||
|
(when (fboundp 'scroll-bar-mode) (scroll-bar-mode -1))
|
||||||
|
(set-frame-parameter nil 'fullscreen 'maximized)
|
||||||
|
(raise-frame)
|
||||||
|
(redisplay t)
|
||||||
|
t)" >"$GUI_RUN_DIR/bootstrap.out"
|
||||||
|
activate_emacs
|
||||||
|
start_recorder
|
||||||
|
"$GUI_EMACSCLIENT" -n -s "$GUI_DAEMON" -e \
|
||||||
|
'(funcall (intern (getenv "ETAF_GUI_ENTRY")))' \
|
||||||
|
>"$GUI_RUN_DIR/scenario.out"
|
||||||
|
stop_recorder
|
||||||
|
require_file "$GUI_RUN_DIR/recording.mov"
|
||||||
|
[ -s "$GUI_RUN_DIR/recording.mov" ] || {
|
||||||
|
echo "screen recording is empty" >&2
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
stop_daemon
|
||||||
|
|
||||||
|
set +e
|
||||||
|
python3 "$GUI_EVIDENCE_PY" finalize --run-dir "$GUI_RUN_DIR" \
|
||||||
|
>"$GUI_RUN_DIR/finalize.out" 2>&1
|
||||||
|
GUI_FINALIZE_STATUS=$?
|
||||||
|
set -e
|
||||||
|
cat "$GUI_RUN_DIR/finalize.out"
|
||||||
|
if [ "$GUI_FINALIZE_STATUS" -eq 1 ]; then
|
||||||
|
echo "GUI verification assertions failed: $GUI_RUN_DIR" >&2
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
if [ "$GUI_FINALIZE_STATUS" -ne 2 ]; then
|
||||||
|
echo "fresh capture unexpectedly bypassed temporal review" >&2
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
echo "EMACS-GUI-VERIFIER CAPTURE COMPLETE verdict=INCOMPLETE entry=$GUI_ENTRY run-dir=$GUI_RUN_DIR"
|
||||||
|
}
|
||||||
|
|
||||||
|
[ "$#" -ge 1 ] || usage
|
||||||
|
GUI_COMMAND=$1
|
||||||
|
shift
|
||||||
|
|
||||||
|
case $GUI_COMMAND in
|
||||||
|
doctor)
|
||||||
|
[ "$#" -eq 0 ] || usage
|
||||||
|
doctor
|
||||||
|
;;
|
||||||
|
review)
|
||||||
|
review_run "$@"
|
||||||
|
;;
|
||||||
|
run)
|
||||||
|
parse_run_arguments "$@"
|
||||||
|
run_adapter
|
||||||
|
;;
|
||||||
|
*) usage ;;
|
||||||
|
esac
|
||||||
146
tests/etaf-gui-verifier-tests.el
Normal file
146
tests/etaf-gui-verifier-tests.el
Normal file
@ -0,0 +1,146 @@
|
|||||||
|
;;; etaf-gui-verifier-tests.el --- Generic GUI scenario engine tests -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'ert)
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'emacs-gui-verifier)
|
||||||
|
|
||||||
|
(ert-deftest etaf-gui-verifier-composes-generic-scenario-actions ()
|
||||||
|
"The engine should own ordering while adapters own actions and assertions."
|
||||||
|
(let ((buffer (generate-new-buffer " *etaf-gui-verifier-test*"))
|
||||||
|
events checkpoints finished (settle-checks 0))
|
||||||
|
(unwind-protect
|
||||||
|
(cl-letf
|
||||||
|
(((symbol-function 'emacs-dynamic-ui-verification-start)
|
||||||
|
(lambda (_directory run-id _claim phases)
|
||||||
|
(push (list 'start run-id phases) events)))
|
||||||
|
((symbol-function 'emacs-dynamic-ui-verification-checkpoint)
|
||||||
|
(lambda (action phase adapter assertions screenshot)
|
||||||
|
(push (list action phase adapter assertions screenshot)
|
||||||
|
checkpoints)))
|
||||||
|
((symbol-function 'emacs-dynamic-ui-verification-finish)
|
||||||
|
(lambda (completed adapter)
|
||||||
|
(setq finished (list completed adapter)))))
|
||||||
|
(let* ((scenario
|
||||||
|
(etaf-gui-verifier-scenario-create
|
||||||
|
:name "generic"
|
||||||
|
:claim "generic claim"
|
||||||
|
:initialize
|
||||||
|
(lambda (context)
|
||||||
|
(etaf-gui-verifier-context-select-buffer context buffer))
|
||||||
|
:invariants
|
||||||
|
(lambda (context)
|
||||||
|
(list
|
||||||
|
(etaf-gui-verifier-assert
|
||||||
|
"buffer-live"
|
||||||
|
(buffer-live-p
|
||||||
|
(etaf-gui-verifier-context-target-buffer context)))))
|
||||||
|
:adapter
|
||||||
|
(lambda (context)
|
||||||
|
(list
|
||||||
|
(cons 'size
|
||||||
|
(with-current-buffer
|
||||||
|
(etaf-gui-verifier-context-target-buffer context)
|
||||||
|
(buffer-size)))))
|
||||||
|
:actions
|
||||||
|
(list
|
||||||
|
(etaf-gui-verifier-action-create
|
||||||
|
:id "insert-a" :settle-interval 0.001
|
||||||
|
:execute
|
||||||
|
(lambda (context)
|
||||||
|
(with-current-buffer
|
||||||
|
(etaf-gui-verifier-context-target-buffer context)
|
||||||
|
(insert "A")))
|
||||||
|
:settled-p
|
||||||
|
(lambda (_context)
|
||||||
|
(>= (cl-incf settle-checks) 2))
|
||||||
|
:assertions
|
||||||
|
(lambda (context)
|
||||||
|
(list
|
||||||
|
(etaf-gui-verifier-assert
|
||||||
|
"one-character"
|
||||||
|
(= 1
|
||||||
|
(with-current-buffer
|
||||||
|
(etaf-gui-verifier-context-target-buffer context)
|
||||||
|
(buffer-size))))))
|
||||||
|
:screenshot t)
|
||||||
|
(etaf-gui-verifier-action-create
|
||||||
|
:id "insert-b"
|
||||||
|
:execute
|
||||||
|
(lambda (context)
|
||||||
|
(with-current-buffer
|
||||||
|
(etaf-gui-verifier-context-target-buffer context)
|
||||||
|
(insert "B")))
|
||||||
|
:settled-p (lambda (_context) t)))
|
||||||
|
:completion
|
||||||
|
(lambda (context)
|
||||||
|
(= 2 (etaf-gui-verifier-context-action-count context)))))
|
||||||
|
(context (etaf-gui-verifier-run scenario "/tmp/generic")))
|
||||||
|
(should (= 2 (etaf-gui-verifier-context-action-count context)))
|
||||||
|
(should (equal "AB" (with-current-buffer buffer (buffer-string))))
|
||||||
|
(should (car finished))
|
||||||
|
(should (= settle-checks 3))
|
||||||
|
(should (= 6 (length checkpoints)))
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'("before-action" "after-action" "after-redisplay"
|
||||||
|
"before-action" "after-action" "after-redisplay")
|
||||||
|
(mapcar #'cadr (nreverse checkpoints))))))
|
||||||
|
(when (buffer-live-p buffer) (kill-buffer buffer)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-gui-verifier-rejects-invalid-settle-contracts ()
|
||||||
|
"Every action should have a bounded, non-busy settle contract."
|
||||||
|
(let ((context (etaf-gui-verifier--context-create)))
|
||||||
|
(dolist
|
||||||
|
(action
|
||||||
|
(list
|
||||||
|
(etaf-gui-verifier-action-create :id "missing")
|
||||||
|
(etaf-gui-verifier-action-create
|
||||||
|
:id "timeout" :settled-p (lambda (_context) t)
|
||||||
|
:settle-timeout 0)
|
||||||
|
(etaf-gui-verifier-action-create
|
||||||
|
:id "interval" :settled-p (lambda (_context) t)
|
||||||
|
:settle-interval 0)))
|
||||||
|
(should-error (etaf-gui-verifier--settle-action context action)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-gui-verifier-timeout-finishes-false-and-propagates ()
|
||||||
|
"A settle timeout should finish incomplete and preserve its error."
|
||||||
|
(let ((buffer (generate-new-buffer " *etaf-gui-timeout-test*"))
|
||||||
|
finished)
|
||||||
|
(unwind-protect
|
||||||
|
(cl-letf
|
||||||
|
(((symbol-function 'emacs-dynamic-ui-verification-start)
|
||||||
|
(lambda (&rest _arguments) nil))
|
||||||
|
((symbol-function 'emacs-dynamic-ui-verification-checkpoint)
|
||||||
|
(lambda (&rest _arguments) nil))
|
||||||
|
((symbol-function 'emacs-dynamic-ui-verification-finish)
|
||||||
|
(lambda (completed adapter)
|
||||||
|
(setq finished (list completed adapter)))))
|
||||||
|
(let* ((scenario
|
||||||
|
(etaf-gui-verifier-scenario-create
|
||||||
|
:name "timeout"
|
||||||
|
:claim "timeout must fail closed"
|
||||||
|
:initialize
|
||||||
|
(lambda (context)
|
||||||
|
(etaf-gui-verifier-context-select-buffer context buffer))
|
||||||
|
:actions
|
||||||
|
(list
|
||||||
|
(etaf-gui-verifier-action-create
|
||||||
|
:id "never-settles"
|
||||||
|
:execute (lambda (_context) nil)
|
||||||
|
:settled-p (lambda (_context) nil)
|
||||||
|
:settle-timeout 0.003
|
||||||
|
:settle-interval 0.001))))
|
||||||
|
(error-data
|
||||||
|
(should-error
|
||||||
|
(etaf-gui-verifier-run scenario "/tmp/timeout"))))
|
||||||
|
(should
|
||||||
|
(string-match-p
|
||||||
|
"did not settle" (error-message-string error-data)))
|
||||||
|
(should finished)
|
||||||
|
(should-not (car finished))))
|
||||||
|
(when (buffer-live-p buffer) (kill-buffer buffer)))))
|
||||||
|
|
||||||
|
(provide 'etaf-gui-verifier-tests)
|
||||||
|
;;; etaf-gui-verifier-tests.el ends here
|
||||||
Loading…
Reference in New Issue
Block a user