branch: externals/topspace
commit cb9dbf5c0f7a7d7c60daeed8f00c20e750f5ffec
Author: Trevor Pogue <pogu...@mcmaster.ca>
Commit: Trevor Pogue <pogu...@mcmaster.ca>
Start adding tests
---
tests/director-bootstrap.el | 42 ++++++
tests/director.el | 304 ++++++++++++++++++++++++++++++++++++++++++++
tests/run | 15 +++
tests/tests.el | 40 ++++++
4 files changed, 401 insertions(+)
diff --git a/tests/director-bootstrap.el b/tests/director-bootstrap.el
new file mode 100644
index 0000000000..32b9c0fd5e
--- /dev/null
+++ b/tests/director-bootstrap.el
@@ -0,0 +1,42 @@
+;; Scenarios might be stored in a projects's source tree but are
+;; supposed to run in a clean environment. Disable reading
+;; `.dir-locals.el' so that Emacs doesn't try to load it from the
+;; project's source tree. This cannot come as part of the
+;; `director-bootstrap' function because, by the time that's called by
+;; a file in the source tree, Emacs will already have tried to load
+;; the corresponding `.dir-locals.el' file.
+
+(setq enable-dir-local-variables nil)
+
+(defun director-bootstrap (&rest config)
+ "Setup the environment for a simulated user session."
+
+ (require 'package)
+
+ (setq byte-compile-warnings nil)
+ (when (boundp 'comp-async-report-warnings-errors)
+ (setq comp-async-report-warnings-errors nil))
+
+ (let ((user-dir (plist-get config :user-dir))
+ (packages (plist-get config :packages))
+ (additional-load-paths (plist-get config :load-path)))
+
+ (when user-dir
+ (setq user-emacs-directory user-dir)
+ (setq package-user-dir (expand-file-name "elpa" user-emacs-directory)))
+
+ (when additional-load-paths
+ (setq load-path (append load-path additional-load-paths)))
+
+ ;; attempt requiring director here; if error, add director to list of
required
+ ;; packages, and retry after initializing packages
+
+ (package-initialize)
+ (when packages
+ (add-to-list 'package-archives '("melpa" .
"https://melpa.org/packages/";) t)
+ (dolist (package packages)
+ (unless (package-installed-p package)
+ (package-install package))))
+
+ (require 'director)))
+
diff --git a/tests/director.el b/tests/director.el
new file mode 100644
index 0000000000..aeb1fe0d5c
--- /dev/null
+++ b/tests/director.el
@@ -0,0 +1,304 @@
+;;; director.el --- Simulate user sessions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Massimiliano Mirra
+
+;; Author: Massimiliano Mirra <hyperstr...@gmail.com>
+;; URL: https://github.com/bard/emacs-director
+;; Version: 0.1
+;; Package-Requires: ((emacs "27.1"))
+;; Keywords: maint, tools
+
+;; This file is not part of GNU Emacs
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; For a full copy of the GNU General Public License
+;; see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Simulate user sessions.
+
+;;; Code:
+(require 'map)
+(require 'seq)
+
+(defvar director--delay 1)
+(defvar director--steps nil)
+(defvar director--start-time nil)
+(defvar director--counter 0)
+(defvar director--error nil)
+(defvar director--failure nil)
+(defvar director--before-start-function nil)
+(defvar director--after-end-function nil)
+(defvar director--before-step-function nil)
+(defvar director--after-step-function nil)
+(defvar director--on-error-function nil)
+(defvar director--on-failure-function nil)
+(defvar director--log-target nil)
+(defvar director--typing-style nil)
+
+(defun director-run (&rest config)
+ "Simulate a user session as defined by CONFIG.
+
+CONFIG is a property list containing the following properties and
+their values:
+
+- `:version': required number indicating the config format
+ version; must be `1'
+- `:steps': required list of steps (see below for the step
+ format)
+- `:before-start' : optional function to run before the first
+ step
+- `:after-end' optional function to run after the last step
+- `:after-step' optional function to run after every step
+- `:on-failure': optional function to run when an `:assert' step
+ fails
+- `:on-error': optional function to run when a step triggers an
+ error
+- `:log-target': optional cons cell of the format `(file
+ . \"filename\")' specifying a file to save the log to
+- `:typing-style': optional symbol changing the way that `:type'
+ steps type characters; set to `human' to simulate a human
+ typing
+- `:delay-between-steps': optional number specifying how many
+ seconds to wait after a step; defaults to `1'; set lower for
+ automated tests
+
+A step can be one of:
+
+- `:type': simulate typing text; can be a string or a vector of
+ key events; if a string, it will be converted to key events
+ using `listify-key-sequence' and can contain special
+ characters, e.g. `(:type \"\\M-xsetenv\\r\")'
+- `:call': shortcut to invoke an interactive command, e.g. `(:call setenv)'
+- `:log': Lisp form; it will be evaluated and its result will be
+ written to log; e.g. `(:log (buffer-file-name (current-buffer)))'
+- `:wait': number; seconds to wait before next step; overrides
+ config-wide `:delay-between-steps'
+- `:assert': Lisp form; if it evaluates to nil, execution is
+ interrupted and function configured through `:on-failure' is
+ called
+- `:suspend': suspend execution; useful for debugging; resume
+ using the `director-resume' command"
+ (director--read-config config)
+ (setq director--start-time (float-time))
+ (director--before-start)
+ (director--schedule-next))
+
+(defun director--read-config (config)
+ "Read CONFIG values into global state."
+ (or (map-elt config :version)
+ (error "Director: configuration entry `:version' missing"))
+ (or (map-elt config :steps)
+ (error "Director: configuration entry `:steps' missing"))
+ (mapc (lambda (config-entry)
+ (pcase config-entry
+ (`(:version ,version)
+ (or (equal version 1)
+ (error "Invalid :version")))
+ (`(:steps ,steps)
+ (setq director--steps steps))
+ (`(:delay-between-steps ,delay)
+ (setq director--delay delay))
+ (`(:before-step ,function)
+ (setq director--before-step-function function))
+ (`(:before-start ,function)
+ (setq director--before-start-function function))
+ (`(:after-end ,function)
+ (setq director--after-end-function function))
+ (`(:after-step ,function)
+ (setq director--after-step-function function))
+ (`(:on-error ,function)
+ (setq director--on-error-function function))
+ (`(:on-failure ,function)
+ (setq director--on-failure-function function))
+ (`(:log-target ,target)
+ (setq director--log-target target))
+ (`(:typing-style ,style)
+ (setq director--typing-style style))
+ (entry
+ (error "Director: invalid configuration entry: `%s'" entry))))
+ (seq-partition config 2)))
+
+(defun director--log (message)
+ "Log MESSAGE."
+ (when director--log-target
+ (let ((log-line (format "%06d %03d %s\n"
+ (round (- (* 1000 (float-time))
+ (* 1000 director--start-time)))
+ director--counter
+ message))
+ (target-type (car director--log-target))
+ (target-name (cdr director--log-target)))
+ (pcase target-type
+ ('buffer
+ (with-current-buffer (get-buffer-create target-name)
+ (goto-char (point-max))
+ (insert log-line)))
+ ('file
+ (let ((save-silently t))
+ (append-to-file log-line nil target-name)))
+ (_
+ (error "Unrecognized log target type: %S" target-type))))))
+
+(defun director--schedule-next (&optional delay-override)
+ "Schedule next step.
+If DELAY-OVERRIDE is non-nil, the next step is delayed by that value rather
than
+`director--delay'."
+ (cond
+ (director--error
+ (director--log (format "ERROR %S" director--error))
+ (run-with-timer director--delay nil 'director--end))
+
+ (director--failure
+ (director--log (format "FAILURE: %S" director--failure))
+ (run-with-timer director--delay nil 'director--end))
+
+ ((equal (length director--steps) 0)
+ ;; Run after-step callback for last step
+ (director--after-step)
+ (run-with-timer (or delay-override director--delay) nil 'director--end))
+
+ (t
+ (unless (eq director--counter 0)
+ (director--after-step))
+ (let* ((next-step (car director--steps))
+ (delay (cond (delay-override delay-override)
+ ((and (listp next-step)
+ (member (car next-step) '(:call :type)))
+ director--delay)
+ (t 0.05))))
+ (run-with-timer delay
+ nil
+ (lambda ()
+ (director--before-step)
+ (director--exec-step-then-next)))))))
+
+(defun director--exec-step-then-next ()
+ "Execute current step, scheduling next step."
+ (let ((step (car director--steps)))
+ (setq director--counter (1+ director--counter)
+ director--steps (cdr director--steps))
+ (director--log (format "STEP %S" step))
+ (condition-case err
+ (pcase step
+ (`(:call ,command)
+ ;; Next step must be scheduled before executing the command, because
+ ;; the command might block (e.g. when requesting input) in which
case
+ ;; we'd never get to schedule the step.
+ (director--schedule-next)
+ (call-interactively command))
+
+ (`(:log ,form)
+ (director--schedule-next)
+ (director--log (format "LOG %S" (eval form))))
+
+ (`(:type ,key-sequence)
+ (if (eq director--typing-style 'human)
+ (director--simulate-human-typing
+ (listify-key-sequence key-sequence)
+ 'director--schedule-next)
+ (director--schedule-next)
+ (setq unread-command-events
+ (listify-key-sequence key-sequence))))
+
+ (`(:wait ,delay)
+ (director--schedule-next delay))
+
+ (`(:suspend)
+ nil)
+
+ (`(:assert ,condition)
+ (or (eval condition)
+ (setq director--failure condition))
+ (director--schedule-next))
+
+ (step
+ (director--schedule-next)
+ (error "Unrecognized step: %S" step)))
+
+ ;; Save error so that already scheduled step can handle it
+ (error (setq director--error err)))))
+
+(defun director--simulate-human-typing (command-events callback)
+ "Simulate typing COMMAND-EVENTS and then execute CALLBACK."
+ (if command-events
+ (let* ((base-delay-ms 50)
+ (random-variation-ms (- (random 50) 25))
+ (delay-s (/ (+ base-delay-ms random-variation-ms) 1000.0)))
+ (setq unread-command-events (list (car command-events)))
+ (run-with-timer delay-s nil 'director--simulate-human-typing (cdr
command-events) callback))
+ (funcall callback)))
+
+;;; Hooks
+
+(defun director--before-step ()
+ "Execute `director--before-step-function'."
+ (when director--before-step-function
+ (funcall director--before-step-function)))
+
+(defun director--after-step ()
+ "Execute `director--after-step-function'."
+ (when director--after-step-function
+ (funcall director--after-step-function)))
+
+(defun director--before-start ()
+ "Execute `director--before-start-function'."
+ (when director--before-start-function
+ (funcall director--before-start-function)))
+
+(defun director--end ()
+ "Update global state after steps are run."
+ (director--log "END")
+ (setq director--counter 0)
+ (setq director--start-time nil)
+ (cond
+ ((and director--error director--on-error-function)
+ ;; Give time to the current event loop iteration to finish
+ ;; in case the on-error hook is a `kill-emacs'
+ (setq director--error nil)
+ (run-with-timer 0.05 nil director--on-error-function))
+ ((and director--failure director--on-failure-function)
+ (setq director--failure nil)
+ (run-with-timer 0.05 nil director--on-failure-function))
+ (director--after-end-function
+ (run-with-timer 0.05 nil director--after-end-function))))
+
+;;; Utilities
+
+;; Use to capture a "screenshot" when running under screen:
+;;
+;; :after-step (lambda ()
+;; (director-capture-screen
"snapshots/scenario-1/snapshot.%d"))
+
+(defun director-capture-screen (file-name-pattern)
+ "Capture screen in to directory matching FILE-NAME-PATTERN."
+ (let ((capture-directory (file-name-directory file-name-pattern))
+ (file-name-pattern (or file-name-pattern
+ (concat temporary-file-directory
+ "director-capture.%d"))))
+ (make-directory capture-directory t)
+ (call-process "screen"
+ nil nil nil
+ "-X" "hardcopy" (format file-name-pattern
+ director--counter))))
+
+(defun director-resume ()
+ "Resume from a `(:suspend)' step."
+ (interactive)
+ (director--schedule-next))
+
+;;; Meta
+
+(provide 'director)
+
+;;; director.el ends here
diff --git a/tests/run b/tests/run
new file mode 100755
index 0000000000..6b68ce9c0d
--- /dev/null
+++ b/tests/run
@@ -0,0 +1,15 @@
+#!/usr/bin/env bash
+
+# set -e
+this_scripts_dir="$(cd "$( dirname "${BASH_SOURCE[0]}" )" &> /dev/null && pwd)"
+cd $this_scripts_dir
+emacs -Q \
+ -l ../topspace.el \
+ -l ./director.el \
+ -l ./director-bootstrap.el \
+ -l ./tests.el
+if [ $? -eq 0 ]; then
+ echo PASS
+else
+ echo FAIL
+fi
diff --git a/tests/tests.el b/tests/tests.el
new file mode 100644
index 0000000000..65e74e84ae
--- /dev/null
+++ b/tests/tests.el
@@ -0,0 +1,40 @@
+;; Run with:
+;;
+;; emacs -Q -nw -l ../../util/director-bootstrap.el -l demo.el
+;; (require 'topspace)
+
+(director-bootstrap
+ :user-dir "/tmp/director-demo"
+ :packages '()
+ :load-path '("./"))
+
+(defun t-t () (kill-emacs 1))
+
+(director-run
+ :version 1
+ :before-start (lambda ()
+ (global-set-key (kbd "C-M-n") 'scroll-down-line)
+ (global-set-key (kbd "C-M-p") 'scroll-up-line)
+ (global-set-key (kbd "C-M-e") 'end-of-buffer)
+ (switch-to-buffer (find-file-noselect "../topspace.el" t))
+ (global-topspace-mode)
+ )
+ :steps '(
+ (:type "\M-v")
+ (:type "\C-\M-n")
+ (:assert (setq topspace--tests-prev-height (topspace--height)))
+ (:type "\C-n")
+ (:assert (= (topspace--height) (1- topspace--tests-prev-height)))
+ (:type "\C-u2\C-n")
+ (:assert (= (topspace--height) (- topspace--tests-prev-height 3)))
+ (:type "\C-\M-n")
+ (:assert (= (topspace--height) (- topspace--tests-prev-height 2)))
+ (:type "\C-u2\C-\M-n")
+ (:assert (= (topspace--height) topspace--tests-prev-height))
+ )
+ :typing-style 'human
+ :delay-between-steps 0.1
+ :after-end (lambda () (kill-emacs 0))
+ :on-failure (lambda () (kill-emacs 1))
+ :on-error (lambda () (kill-emacs 1))
+ )
