;;; etaf-gui-verifier-tests.el --- Generic GUI scenario engine tests -*- lexical-binding: t; -*-

;;; Code:

(require 'ert)
(require 'cl-lib)
(require 'json)
(require 'emacs-gui-verifier)

(ert-deftest etaf-gui-verifier-measures-success-and-original-failure ()
  "Each callback retains its own timing, result, and error condition."
  (let* ((scenario (etaf-gui-verifier-scenario-create :name "measurement"))
         (context (etaf-gui-verifier--context-create :scenario scenario))
         (result (list 'exact-result))
         (error-data (list "original failure" result))
         (wall-times '(1.0 1.002 10.0 10.03))
         (cpu-times '((1000 . 1000) (1004 . 1000)
                      (2000 . 1000) (2010 . 1000)))
         (gcs-done 5) (gc-elapsed 0.1)
         (calls 0))
    (cl-letf (((symbol-function 'float-time)
               (lambda (&optional _time) (pop wall-times)))
              ((symbol-function 'current-cpu-time)
               (lambda () (pop cpu-times))))
      (should
       (eq result
           (etaf-gui-verifier-measure-action
            context
            (etaf-gui-verifier-action-create
             :id "success"
             :execute (lambda (current)
                        (should (eq current context))
                        (cl-incf calls)
                        result)))))
      (should
       (equal (cons 'error error-data)
              (should-error
               (etaf-gui-verifier-measure-action
                context
                (etaf-gui-verifier-action-create
                 :id "failure"
                 :execute (lambda (_current)
                            (cl-incf calls)
                            (cl-incf gcs-done 2)
                            (cl-incf gc-elapsed 0.003)
                            (signal 'error error-data))))))))
    (should (= calls 2))
    (let* ((measurements (etaf-gui-verifier-context-measurements context))
           (failed (car measurements))
           (succeeded (cadr measurements))
           (adapter (etaf-gui-verifier--adapter-data context)))
      (should (= (length measurements) 2))
      (should (equal (alist-get 'status succeeded) "success"))
      (should (equal (alist-get 'status failed) "error"))
      (should (equal (alist-get 'action_id failed) "failure"))
      (should-not (alist-get 'valid failed))
      (should (< (abs (- (alist-get 'wall_ms failed) 30.0)) 0.001))
      (should (< (abs (- (alist-get 'wall_ms succeeded) 2.0)) 0.001))
      (should (< (abs (- (alist-get 'cpu_ms failed) 10.0)) 0.001))
      (should (= (alist-get 'gc_count failed) 2))
      (should (< (abs (- (alist-get 'gc_ms failed) 3.0)) 0.001))
      (should (= (alist-get 'duration_ms adapter)
                 (alist-get 'wall_ms failed)))
      (should (eq (alist-get 'last_measurement adapter) failed))
      (should-not (assq 'measurements adapter)))))

(ert-deftest etaf-gui-verifier-labels-callback-context-without-changing-it ()
  "Foreground, background, and unknown callbacks keep their execution context."
  (let* ((focus t) (calls 0)
         (inhibit-quit t) (inhibit-redisplay t)
         (threshold gc-cons-threshold) (percentage gc-cons-percentage)
         (context
          (etaf-gui-verifier--context-create
           :target-buffer (window-buffer (selected-window)))))
    (cl-letf (((symbol-function 'display-graphic-p)
               (lambda (&optional _frame) t))
              ((symbol-function 'frame-focus-state)
               (lambda (&optional _frame) focus))
              ((symbol-function 'redisplay)
               (lambda (&rest _arguments) (ert-fail "Forced redisplay")))
              ((symbol-function 'sit-for)
               (lambda (&rest _arguments) (ert-fail "Waited for display")))
              ((symbol-function 'garbage-collect)
               (lambda () (ert-fail "Forced GC"))))
      (dolist (state '((t "foreground") (nil "background") (unknown "unknown")))
        (setq focus (car state))
        (should
         (eq 'exact-result
             (etaf-gui-verifier-measure-action
              context
              (etaf-gui-verifier-action-create
               :id "context"
               :execute (lambda (_context)
                          (cl-incf calls)
                          (should inhibit-quit)
                          (should inhibit-redisplay)
                          (should (= gc-cons-threshold threshold))
                          (should (= gc-cons-percentage percentage))
                          'exact-result))
              (eq focus t))))
        (let* ((measurement
                (car (etaf-gui-verifier-context-measurements context)))
               (before (alist-get 'before measurement)))
          (should (equal (alist-get 'foreground measurement) (cadr state)))
          (should (equal (alist-get 'status measurement) "success"))
          (should (alist-get 'valid measurement))
          (should (alist-get 'inhibit_quit before))
          (should (alist-get 'inhibit_redisplay before))
          (should (eq (alist-get 'noninteractive before) noninteractive))
          (should (stringp (json-serialize measurement))))))
    (should (= calls 3))))

(ert-deftest etaf-gui-verifier-unselected-target-runs-with-invalid-timing ()
  "An unchanged unselected target permits the callback but invalidates timing."
  (let* ((target (generate-new-buffer " *etaf-gui-unselected-target*"))
         (context (etaf-gui-verifier--context-create :target-buffer target))
         (result (list 'exact-result))
         (calls 0))
    (unwind-protect
        (cl-letf (((symbol-function 'display-graphic-p)
                   (lambda (&optional _frame) t))
                  ((symbol-function 'frame-focus-state)
                   (lambda (&optional _frame) nil)))
          (should
           (eq result
               (etaf-gui-verifier-measure-action
                context
                (etaf-gui-verifier-action-create
                 :id "unselected-target"
                 :execute (lambda (_context)
                            (cl-incf calls)
                            result)))))
          (should (= calls 1))
          (let ((measurement
                 (car (etaf-gui-verifier-context-measurements context))))
            (should (equal (alist-get 'status measurement) "success"))
            (should (equal (alist-get 'foreground measurement) "background"))
            (should (equal (alist-get 'before measurement)
                           (alist-get 'after measurement)))
            (should-not (alist-get 'target_selected
                                   (alist-get 'before measurement)))
            (should-not (alist-get 'valid measurement))
            (should (numberp (alist-get 'wall_ms measurement)))))
      (kill-buffer target))))

(ert-deftest etaf-gui-verifier-foreground-rejection-does-not-execute-or-focus ()
  "Foreground requirements reject absent focus or targets before execution."
  (let ((focus t) (graphic t) (calls 0)
        (context (etaf-gui-verifier--context-create)))
    (cl-letf (((symbol-function 'display-graphic-p)
               (lambda (&optional _frame) graphic))
              ((symbol-function 'frame-focus-state)
               (lambda (&optional _frame) focus))
              ((symbol-function 'raise-frame)
               (lambda (&rest _arguments) (ert-fail "Raised frame")))
              ((symbol-function 'select-frame-set-input-focus)
               (lambda (&rest _arguments) (ert-fail "Changed focus")))
              ((symbol-function 'x-focus-frame)
               (lambda (&rest _arguments) (ert-fail "Focused frame"))))
      (dolist (state '((nil t t) (unknown t t) (t nil t) (t t nil)))
        (setq focus (nth 0 state) graphic (nth 1 state))
        (setf (etaf-gui-verifier-context-target-buffer context)
              (and (nth 2 state) (window-buffer (selected-window))))
        (should-error
         (etaf-gui-verifier-measure-action
          context
          (etaf-gui-verifier-action-create
           :id "foreground-only" :execute (lambda (_context) (cl-incf calls)))
          t))
        (let ((measurement
               (car (etaf-gui-verifier-context-measurements context))))
          (should (equal (alist-get 'status measurement) "rejected"))
          (should-not (alist-get 'valid measurement))
          (should-not (alist-get 'wall_ms measurement)))))
    (should (zerop calls))))

(ert-deftest etaf-gui-verifier-retains-valid-timing-when-frame-title-changes ()
  "A GC count in the frame title must not invalidate a stable target."
  (let* ((gcs-done 713)
         (calls 0)
         (result (list 'exact-result))
         (frame-parameter-function (symbol-function 'frame-parameter))
         (context
          (etaf-gui-verifier--context-create
           :target-buffer (window-buffer (selected-window)))))
    (cl-letf (((symbol-function 'display-graphic-p)
               (lambda (&optional _frame) t))
              ((symbol-function 'frame-focus-state)
               (lambda (&optional _frame) t))
              ((symbol-function 'frame-parameter)
               (lambda (frame parameter)
                 (if (eq parameter 'name) (format "GC%d" gcs-done)
                   (funcall frame-parameter-function frame parameter)))))
      (should
       (eq result
           (etaf-gui-verifier-measure-action
            context
            (etaf-gui-verifier-action-create
             :id "title-update"
             :execute (lambda (_context)
                        (cl-incf calls)
                        (cl-incf gcs-done)
                        result))
            t))))
    (should (= calls 1))
    (let ((measurement
           (car (etaf-gui-verifier-context-measurements context))))
      (should (equal (alist-get 'status measurement) "success"))
      (should (equal (alist-get 'foreground measurement) "foreground"))
      (should (alist-get 'valid measurement))
      (should (= (alist-get 'gc_count measurement) 1))
      (should (equal (alist-get 'frame_name (alist-get 'before measurement))
                     "GC713"))
      (should (equal (alist-get 'frame_name (alist-get 'after measurement))
                     "GC714")))))

(ert-deftest etaf-gui-verifier-invalidates-replaced-selected-target ()
  "A different live selected buffer remains an identity change."
  (let ((target (generate-new-buffer " *etaf-gui-original-target*"))
        (replacement (generate-new-buffer " *etaf-gui-replacement-target*"))
        (calls 0))
    (unwind-protect
        (save-window-excursion
          (switch-to-buffer target)
          (let ((context (etaf-gui-verifier--context-create :target-buffer target)))
            (cl-letf (((symbol-function 'display-graphic-p)
                       (lambda (&optional _frame) t))
                      ((symbol-function 'frame-focus-state)
                       (lambda (&optional _frame) t)))
              (should-error
               (etaf-gui-verifier-measure-action
                context
                (etaf-gui-verifier-action-create
                 :id "replace-selected-target"
                 :execute (lambda (_context)
                            (cl-incf calls)
                            (setf (etaf-gui-verifier-context-target-buffer context)
                                  replacement)
                            (set-window-buffer (selected-window) replacement)))
                t)))
            (should (= calls 1))
            (let ((measurement
                   (car (etaf-gui-verifier-context-measurements context))))
              (should (alist-get 'target_selected
                                 (alist-get 'before measurement)))
              (should (alist-get 'target_selected
                                 (alist-get 'after measurement)))
              (should (equal (alist-get 'status measurement) "invalid"))
              (should-not (alist-get 'valid measurement)))))
      (kill-buffer target)
      (kill-buffer replacement))))

(ert-deftest etaf-gui-verifier-invalidates-changed-foreground-environment ()
  "Changed focus, target, font, or dimensions invalidate strict timing."
  (let ((focus t) (width 800) (font "original-font") (calls 0)
        (frame-parameter-function (symbol-function 'frame-parameter))
        (context (etaf-gui-verifier--context-create)))
    (cl-letf (((symbol-function 'display-graphic-p)
               (lambda (&optional _frame) t))
              ((symbol-function 'frame-focus-state)
               (lambda (&optional _frame) focus))
              ((symbol-function 'frame-pixel-width)
               (lambda (&optional _frame) width))
              ((symbol-function 'frame-parameter)
               (lambda (frame parameter)
                 (if (eq parameter 'font) font
                   (funcall frame-parameter-function frame parameter)))))
      (dolist (change '(focus target font dimensions))
        (setq focus t width 800 font "original-font")
        (setf (etaf-gui-verifier-context-target-buffer context)
              (window-buffer (selected-window)))
        (should-error
         (etaf-gui-verifier-measure-action
          context
          (etaf-gui-verifier-action-create
           :id (symbol-name change)
           :execute
           (lambda (_context)
             (cl-incf calls)
             (pcase change
               ('focus (setq focus nil))
               ('target
                (setf (etaf-gui-verifier-context-target-buffer context) nil))
               ('font (setq font "changed-font"))
               ('dimensions (setq width 900)))))
          t))
        (let ((measurement
               (car (etaf-gui-verifier-context-measurements context))))
          (should (equal (alist-get 'status measurement) "invalid"))
          (should (equal (alist-get 'foreground measurement) "changed"))
          (should-not (alist-get 'valid measurement))
          (should (numberp (alist-get 'wall_ms measurement))))))
    (should (= calls 4))))

(ert-deftest etaf-gui-verifier-preserves-quit-despite-focus-change ()
  "A quit keeps its exact data even if strict environment checks also fail."
  (let* ((focus t)
         (quit-data (list 'original-quit))
         (context
          (etaf-gui-verifier--context-create
           :target-buffer (window-buffer (selected-window)))))
    (cl-letf (((symbol-function 'display-graphic-p)
               (lambda (&optional _frame) t))
              ((symbol-function 'frame-focus-state)
               (lambda (&optional _frame) focus)))
      (should
       (equal (cons 'quit quit-data)
              (condition-case condition
                  (etaf-gui-verifier-measure-action
                   context
                   (etaf-gui-verifier-action-create
                    :id "quit"
                    :execute (lambda (_context)
                               (setq focus nil)
                               (signal 'quit quit-data)))
                   t)
                (quit condition)))))
    (let ((measurement
           (car (etaf-gui-verifier-context-measurements context))))
      (should (equal (alist-get 'status measurement) "quit"))
      (should (equal (alist-get 'foreground measurement) "changed"))
      (should-not (alist-get 'valid measurement))
      (should (numberp (alist-get 'wall_ms measurement))))))

(ert-deftest etaf-gui-verifier-retains-timing-despite-closing-snapshot-failure ()
  "Snapshot errors and quits preserve action failures and retain fresh timing."
  (dolist (action-outcome '(error quit success))
    (dolist (snapshot-outcome '(error quit))
      (let* ((context
              (etaf-gui-verifier--context-create
               :target-buffer (window-buffer (selected-window))
               :last-duration-ms 999.0))
             (before (etaf-gui-verifier--measurement-state context))
             (result (list 'exact-result))
             (action-data (list "original-action-failure" result))
             (snapshot-data (list "snapshot-interrupted" result))
             (wall-times '(1.0 1.025))
             (calls 0) (snapshots 0) observed-condition returned)
        (cl-letf (((symbol-function 'float-time)
                   (lambda (&optional _time) (pop wall-times)))
                  ((symbol-function 'etaf-gui-verifier--measurement-state)
                   (lambda (_context)
                     (if (= (cl-incf snapshots) 1) before
                       (signal snapshot-outcome snapshot-data)))))
          (setq returned
                (condition-case condition
                    (etaf-gui-verifier-measure-action
                     context
                     (etaf-gui-verifier-action-create
                      :id "snapshot-failure"
                      :execute (lambda (_context)
                                 (cl-incf calls)
                                 (if (eq action-outcome 'success) result
                                   (signal action-outcome action-data)))))
                  ((error quit)
                   (setq observed-condition condition)
                   nil))))
        (should (= calls 1))
        (should (= snapshots 2))
        (cond
         ((not (eq action-outcome 'success))
          (should (eq (car observed-condition) action-outcome))
          (should (eq (cdr observed-condition) action-data)))
         ((eq snapshot-outcome 'quit)
          (should (eq (car observed-condition) 'quit))
          (should (eq (cdr observed-condition) snapshot-data)))
         (t
          (should-not observed-condition)
          (should (eq returned result))))
        (let* ((measurements (etaf-gui-verifier-context-measurements context))
               (measurement (car measurements)))
          (should (= (length measurements) 1))
          (should-not (alist-get 'valid measurement))
          (should-not (alist-get 'after measurement))
          (should
           (equal (alist-get 'status measurement)
                  (symbol-name
                   (if (and (eq action-outcome 'success)
                            (eq snapshot-outcome 'quit))
                       'quit action-outcome))))
          (should (< (abs (- (alist-get 'wall_ms measurement) 25.0)) 0.001))
          (should (= (etaf-gui-verifier-context-last-duration-ms context)
                     (alist-get 'wall_ms measurement))))))))

(ert-deftest etaf-gui-verifier-measures-callback-without-settle-or-checkpoints ()
  "The action callback is timed separately from checkpoints and settling."
  (let ((context (etaf-gui-verifier--context-create))
        (clock 0.0) events)
    (cl-letf (((symbol-function 'float-time)
               (lambda (&optional _time) clock))
              ((symbol-function 'etaf-gui-verifier--checkpoint)
               (lambda (_context _id phase _screenshot &optional _extra)
                 (cl-incf clock 1.0)
                 (push phase events)))
              ((symbol-function 'etaf-gui-verifier--settle-action)
               (lambda (_context _action)
                 (cl-incf clock 2.0)
                 (push 'settle events))))
      (etaf-gui-verifier--run-action
       context
       (etaf-gui-verifier-action-create
        :id "callback-only"
        :execute (lambda (_context)
                   (cl-incf clock 0.025)
                   (push 'execute events)))))
    (should (< (abs (- (etaf-gui-verifier-context-last-duration-ms context)
                      25.0))
               0.001))
    (should (equal (nreverse events)
                   '("before-action" execute "after-action"
                     settle "after-redisplay")))
    (let ((measurement
           (car (etaf-gui-verifier-context-measurements context))))
      (should (equal (alist-get 'boundary measurement) "action.execute callback"))
      (should-not (alist-get 'presentation_measured measurement)))))

(ert-deftest etaf-gui-verifier-runs-and-settles-without-raising-frame ()
  "Actions and settled checkpoints must complete without raising Emacs."
  (let ((context (etaf-gui-verifier--context-create))
        (settle-checks 0)
        events)
    (cl-letf (((symbol-function 'raise-frame)
               (lambda (&rest _arguments)
                 (error "GUI verifier must preserve application focus")))
              ((symbol-function 'etaf-gui-verifier--checkpoint)
               (lambda (_context _action-id phase _screenshot &optional _extra)
                 (push phase events))))
      (etaf-gui-verifier--run-action
       context
       (etaf-gui-verifier-action-create
        :id "background-action" :settle-interval 0.001
        :execute
        (lambda (current)
          (etaf-gui-verifier-context-put current 'executed t)
          (push 'execute events))
        :settled-p
        (lambda (current)
          (should (etaf-gui-verifier-context-get current 'executed))
          (cl-incf settle-checks)
          (push 'settle events)
          t)
        :assertions
        (lambda (_current)
          (push 'assertions events)
          (list (etaf-gui-verifier-assert "action-settled" t))))))
    (should (= 1 (etaf-gui-verifier-context-action-count context)))
    (should (= 2 settle-checks))
    (should
     (equal '("before-action" execute "after-action" settle settle
              assertions "after-redisplay")
            (nreverse events)))))

(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