branch: externals/topspace commit 4724b926a4d21f8629f5cb3a1412fbd5b99b17b4 Author: Trevor Pogue <trevorpo...@gmail.com> Commit: Trevor Pogue <pogu...@mcmaster.ca>
Add continuous integration and coverage --- .github/workflows/test.yml | 33 +++++ .gitignore | 6 +- Cask | 10 ++ README.md | 3 +- test/test-helper.el | 19 +++ test/topspace-test.el | 134 +++++++++++++++++++ tests/director-bootstrap.el | 40 ------ tests/director.el | 309 -------------------------------------------- tests/run | 31 ----- tests/tests.el | 57 -------- 10 files changed, 203 insertions(+), 439 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000000..3dd84b5ae3 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,33 @@ +name: Test +on: [ push, pull_request ] +jobs: + test: + runs-on: ubuntu-latest + strategy: + matrix: + emacs_version: + - 25.1 + - 26.1 + - 27.1 + - 28.1 + - snapshot + steps: + - uses: purcell/setup-emacs@master + with: + version: ${{ matrix.emacs_version }} + - uses: conao3/setup-cask@master + - uses: actions/checkout@v2 + - name: Test + env: + COVERALLS_FLAG_NAME: Emacs ${{ matrix.emacs_version }} + COVERALLS_PARALLEL: 1 + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run: | + cask install + cask exec buttercup -L . + finalize: + runs-on: ubuntu-latest + if: always() + needs: test + steps: + - run: curl "https://coveralls.io/webhook?repo_name=$GITHUB_REPOSITORY&repo_token=${{ secrets.GITHUB_TOKEN }}" -d "payload[build_num]=$GITHUB_RUN_NUMBER&payload[status]=done" diff --git a/.gitignore b/.gitignore index 25db118621..c5c0ca413c 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,7 @@ *.~undo-tree~ .projectile -*.elc \ No newline at end of file +*.elc +.cask +coverage/ +cask-run +test/director/ \ No newline at end of file diff --git a/Cask b/Cask new file mode 100644 index 0000000000..3841c24836 --- /dev/null +++ b/Cask @@ -0,0 +1,10 @@ +(source gnu) +(source melpa) + +(development + (depends-on "undercover") + (depends-on "buttercup") + (depends-on "cl-lib") + (depends-on "smooth-scrolling")) + +(package-file "topspace.el") diff --git a/README.md b/README.md index 44ee339d18..099fac49b2 100644 --- a/README.md +++ b/README.md @@ -4,9 +4,10 @@ <!-- cursor --> <p align="center"> + <a href="https://github.com/trevorpogue/topspace/actions/workflows/test.yml/"><img src="https://github.com/trevorpogue/topspace/actions/workflows/test.yml/badge.svg" height="20"/></a> + <a href='https://coveralls.io/github/trevorpogue/topspace'><img src='https://coveralls.io/repos/github/trevorpogue/topspace/badge.svg&kill_cache=1' alt='Coverage Status' /></a> <a href="http://melpa.org/#/topspace"><img src="http://melpa.org/packages/topspace-badge.svg" height="20"/></a> <a href="http://stable.melpa.org/#/topspace"><img src="http://stable.melpa.org/packages/topspace-badge.svg" height="20"/></a> - <a href="https://www.gnu.org/licenses/gpl-3.0"><img src="https://img.shields.io/badge/License-GPLv3-blue.svg" height="20"/></a> </p> <p align="center"><img src="https://user-images.githubusercontent.com/12535207/164986647-cdb35afa-de45-4e6f-ac16-fad765f9969e.gif"/></p> diff --git a/test/test-helper.el b/test/test-helper.el new file mode 100644 index 0000000000..c7169f8ab9 --- /dev/null +++ b/test/test-helper.el @@ -0,0 +1,19 @@ +;;; test-helper.el --- Helper for tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Trevor Edwin Pogue + +;; Author: Trevor Edwin Pogue + +;;; Code: + +(when (require 'undercover nil t) + (setq undercover-force-coverage t) + (undercover "*.el" + ;; (:report-file "coverage/.resultset.json") + ;; (:report-format 'simplecov) + )) + +(require 'smooth-scrolling) +(require 'topspace) + +;;; test-helper.el ends here diff --git a/test/topspace-test.el b/test/topspace-test.el new file mode 100644 index 0000000000..5c4eb852c3 --- /dev/null +++ b/test/topspace-test.el @@ -0,0 +1,134 @@ +;;; test-topspace.el --- Main test file -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Trevor Edwin Pogue + +;; Author: Trevor Edwin Pogue + +;;; Code: + +(defmacro topspace--cmds (&rest cmds) + "Run CMDS with command hooks." + (let ((result '(progn))) + (dolist (cmd cmds) + (setq result + (append result + `((run-hooks 'pre-command-hook) + (eval ',cmd) + (run-hooks 'post-command-hook) + )))) + result)) + +(describe "topspace" + :var (prev-height) + + (before-all + (topspace--cmds (set-frame-size (selected-frame) 101 24)) + (switch-to-buffer (find-file-noselect "./topspace.el" t)) + (global-topspace-mode 1)) + + (before-each (switch-to-buffer "topspace.el") + (setq smooth-scrolling-mode nil)) + + (it "reduces top space height before cursor can move below window-end" + (goto-char 1) + (topspace--draw 0) + (topspace--cmds + (scroll-down) + (scroll-up) + (scroll-down) + ) + (setq prev-height (topspace-height)) + (topspace--cmds + (next-line)) + (expect (topspace-height) :to-equal (1- prev-height)) + (topspace--cmds (next-line) (next-line)) + (expect (topspace-height) :to-equal (- prev-height 3))) + + (it "moves cursor up before cursor is scrolled below window-end" + (topspace--cmds (scroll-down-line)) + (expect (topspace-height) :to-equal (- prev-height 2)) + (topspace--cmds + (scroll-down-line) + (scroll-down-line)) + (expect (topspace-height) :to-equal prev-height) + (topspace--cmds (scroll-up-line)) + (expect (topspace-height) :to-equal (1- prev-height))) + + (describe "topspace--after-scroll" + (it "is needed when first scrolling above the top line" + (progn (topspace--cmds (goto-char 1) + (topspace--draw 0)) + (topspace--cmds (scroll-up-line)) + (condition-case nil (scroll-down 2) + (error (print 'wtf)))) + (expect (topspace-height) :to-equal 0))) + + (describe "topspace--window-configuration-change" + (it "autocenters buffer when window size changes" + (switch-to-buffer "*scratch*") + (topspace--cmds (set-frame-size (selected-frame) 101 24)) + (run-hooks 'window-configuration-change-hook) + (expect (round (* (topspace-height) 10)) :to-equal 86) + (topspace--cmds (set-frame-size (selected-frame) 101 22)) + (run-hooks 'window-configuration-change-hook) + (expect (round (* (topspace-height) 10)) :to-equal 78))) + + (describe "topspace-mode" + (it "can be enabled and disabled locally" + (topspace-mode -1) + (expect topspace-mode :to-equal nil) + (scroll-up-line) + (topspace--draw 1) + (expect (topspace-height) :to-equal 0) + (ignore-errors (scroll-down-line)) + (topspace-mode 1) + (expect topspace-mode :to-equal t) + )) + + (describe "topspace--draw-increase-height" + (it "increases top space height" + (goto-char 1) + (recenter) + (setq prev-height (topspace-height)) + (topspace--draw-increase-height 1) + (expect (topspace-height) :to-equal (1+ prev-height)))) + + (describe "topspace--draw-increase-height" + (it "increases top space height" + (goto-char 1) + (recenter) + (setq prev-height (topspace-height)) + (topspace--draw-increase-height 1) + (expect (topspace-height) :to-equal (1+ prev-height)))) + + (describe "topspace--after-recenter" + (it "adds top space if recentering near top of buffer" + (goto-char 1) + (recenter) + (expect (round (topspace-height)) :to-equal (/ (window-height) 2)) + (recenter -1) + (expect (round (topspace-height)) :to-equal (- (window-height) 2)))) + + (describe "topspace--previous-line" + (it "is to be used like previous-line but non-interactively" + (goto-char 1) + (next-line) + (topspace--previous-line) + (expect (line-number-at-pos) :to-equal 1))) + + (describe "topspace--smooth-scroll-lines-above-point" + (it "allows smooth-scrolling package to work with topspace" + (expect (topspace--smooth-scroll-lines-above-point) + :to-equal (smooth-scroll-lines-above-point)))) + + (describe "topspace-default-empty-line-indicator" + (it "can return a string with an indicator in left-fringe" + (setq indicate-empty-lines t) + (let ((bitmap (catch 'tag (dolist (x fringe-indicator-alist) + (when (eq (car x) 'empty-line) + (throw 'tag (cdr x))))))) + (expect (topspace-default-empty-line-indicator) :to-equal + (propertize " " 'display (list `left-fringe bitmap + `fringe))))))) + +;;; test-topspace.el ends here diff --git a/tests/director-bootstrap.el b/tests/director-bootstrap.el deleted file mode 100644 index 546663c093..0000000000 --- a/tests/director-bootstrap.el +++ /dev/null @@ -1,40 +0,0 @@ -;; 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 deleted file mode 100644 index dcde0a8d59..0000000000 --- a/tests/director.el +++ /dev/null @@ -1,309 +0,0 @@ -;;; 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)' -- `:eval': Lisp form; it will be evaluated -- `: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)) - - (`(:eval ,form) - (eval form) - (director--schedule-next)) - - (`(: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 deleted file mode 100755 index 11df816c40..0000000000 --- a/tests/run +++ /dev/null @@ -1,31 +0,0 @@ -#!/usr/bin/env bash - -check-result() { - if [ $? -eq 0 ]; then - echo PASSED $1 - else - echo FAILED $1 - [ -z "$total_fails" ] && total_fails=0 - ((total_fails++)) - fi -} - -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 -check-result 'in GUI emacs' - -emacs -Q -nw \ - -l ../topspace.el \ - -l ./director.el \ - -l ./director-bootstrap.el \ - -l ./tests.el -check-result 'in terminal emacs' - -[ -n "$total_fails" ] && echo FAILED $total_fails tests && exit 1 -echo PASSED all tests diff --git a/tests/tests.el b/tests/tests.el deleted file mode 100644 index ceaae5b413..0000000000 --- a/tests/tests.el +++ /dev/null @@ -1,57 +0,0 @@ -;; Run with: -;; -;; emacs -Q -nw -l ../../util/director-bootstrap.el -l demo.el - -(director-bootstrap - :user-dir "/tmp/director-demo" - :packages '() - :load-path '("../..")) - -(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) - (switch-to-buffer (find-file-noselect "../topspace.el" t)) - (global-topspace-mode)) - :steps '( - ;; Test scrolling using key commands - (:type "\M-v") ;; page down - (:type "\C-\M-n") ;; scroll down line - (:eval (setq topspace--tests-prev-height (topspace--height))) - (:type "\C-n") ;; next-line - (:assert (= (topspace--height) (1- topspace--tests-prev-height))) - (:type "\C-u2\C-n");; next-line x2 - (:assert (= (topspace--height) (- topspace--tests-prev-height 3))) - (:type "\C-\M-n") ;; scroll down line - (:assert (= (topspace--height) (- topspace--tests-prev-height 2))) - (:type "\C-u2\C-\M-n") ;; scroll down line x2 - (:assert (= (topspace--height) topspace--tests-prev-height)) - ;; reset top line to top of window: - (:type "\C-v") ;; page up - (:assert (= (topspace--height) 1)) - (:type "\C-\M-p") ;; scroll up line - (:assert (= (topspace--height) 0)) - (:assert (= (window-start) 1)) - - ;; Test mouse scrolling - (:type "\M-v") ;; page down - (:eval (mwheel-scroll mouse-wheel-down-event)) ;; scroll down line - (:assert (setq topspace--tests-prev-height (topspace--height))) - (:type "\C-n") ;; next-line - (:assert (= (topspace--height) (1- topspace--tests-prev-height))) - (:type "\C-u2\C-n");; next-line x2 - (:assert (= (topspace--height) (- topspace--tests-prev-height 3))) - (:eval (mwheel-scroll mouse-wheel-down-event)) ;; scroll down line - (:eval (mwheel-scroll mouse-wheel-up-event)) ;; scroll up line - (:eval (mwheel-scroll mouse-wheel-down-event)) ;; scroll down line - (:assert (= (topspace--height) (- topspace--tests-prev-height 2))) - (:eval (mwheel-scroll mouse-wheel-down-event)) ;; scroll down line - (:eval (mwheel-scroll mouse-wheel-down-event)) ;; scroll down line - (: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)))