diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-01-17 11:21:35 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-01-17 11:21:35 -0700 |
| commit | 8c99f26f472d8aa3982b299f0994ad3a5ebe683f (patch) | |
| tree | 07ebcccb0194947e416fc6ece275c290f1d28146 | |
| parent | 2d0619ebd79ba953050ea68ea5187c285ff3682b (diff) | |
| parent | 1de6be465cfe2c3f00183de9351bd838690c9f81 (diff) | |
Merge tag 'v1.24'
Bump version: 1.23 → 1.24
| -rw-r--r-- | .bumpversion.cfg | 2 | ||||
| -rw-r--r-- | .github/workflows/test.yml | 41 | ||||
| -rw-r--r-- | .travis.yml | 17 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rwxr-xr-x | bin/buttercup | 46 | ||||
| -rw-r--r-- | bin/buttercup.bat | 46 | ||||
| -rw-r--r-- | buttercup-compat.el | 11 | ||||
| -rw-r--r-- | buttercup-pkg.el | 2 | ||||
| -rw-r--r-- | buttercup.el | 529 | ||||
| -rw-r--r-- | docs/running-tests.md | 91 | ||||
| -rw-r--r-- | tests/test-buttercup.el | 774 |
11 files changed, 1218 insertions, 345 deletions
diff --git a/.bumpversion.cfg b/.bumpversion.cfg index a8621c9..94fa0fe 100644 --- a/.bumpversion.cfg +++ b/.bumpversion.cfg @@ -1,5 +1,5 @@ [bumpversion] -current_version = 1.22 +current_version = 1.24 parse = (?P<major>\d+)\.(?P<minor>.*) serialize = {major}.{minor} files = buttercup.el buttercup-pkg.el diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..7906981 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,41 @@ +name: Build and test + +on: + pull_request: + push: + branches: + - 'master' + - '*' + paths-ignore: + - 'bin/*' + - 'docs/images/*' + - 'docs/running-tests.md' + - 'scripts' + +jobs: + build: + name: Build and test + runs-on: ubuntu-latest + strategy: + matrix: + emacs_version: + - 24.3 + - 24.4 + - 24.5 + - 25.1 + - 25.2 + - 25.3 + - 26.1 + - 26.2 + - 26.3 + - 27.1 + - snapshot + steps: + - uses: purcell/setup-emacs@master + with: + version: ${{ matrix.emacs_version }} + + - uses: actions/checkout@v2 + - name: Run tests + run: make test + diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 74c768e..0000000 --- a/.travis.yml +++ /dev/null @@ -1,17 +0,0 @@ -language: emacs-lisp -dist: xenial -env: - - EVM_EMACS=emacs-24.3-travis - - EVM_EMACS=emacs-24.4-travis - - EVM_EMACS=emacs-24.5-travis - - EVM_EMACS=emacs-25.1-travis - - EVM_EMACS=emacs-25.2-travis - - EVM_EMACS=emacs-26.1-travis-linux-xenial - - EVM_EMACS=emacs-26.2-travis-linux-xenial - - EVM_EMACS=emacs-26.3-travis-linux-xenial -before_install: - - sudo apt-get install libgnutls30 - - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > travis.sh && source ./travis.sh - - evm install "$EVM_EMACS" --use --skip -script: - - make test @@ -10,7 +10,7 @@ all: test test: test-buttercup test-docs test-buttercup: compile - ./bin/buttercup -L . tests + ./bin/buttercup -L . tests $(if $(CI),--traceback pretty) test-docs: compile $(EMACS) -batch -L . -l buttercup.el -f buttercup-run-markdown docs/writing-tests.md @@ -25,4 +25,4 @@ release: clean test tar -c $(DISTFILES) --transform "s,^,buttercup-$(VERSION)/," --transform 's/README.md/README.txt/' > "dist/buttercup-$(VERSION).tar" clean: - rm -f *.elc + rm -f *.elc tests/*.elc diff --git a/bin/buttercup b/bin/buttercup index 606436b..2230e84 100755 --- a/bin/buttercup +++ b/bin/buttercup @@ -29,22 +29,37 @@ Buttercup options: --pattern, -p PATTERN Only run tests with names matching PATTERN. This option can be used multiple times, in which case tests will be run if they match - any of the given patterns. + any of the given patterns. PATTERN should be + an Emacs regex that will be matched against + the full test description (the concatenation + of the test and all parent suites + descriptions). + +--no-skip Do not print the descriptions for tests that + are filtered out with "--pattern" or disabled + with "xit". Tests skipped wiath "assume" will + still be priuted, + +--only-error Only print failed tests and their containing suites. + Implies "--no-skip". --no-color, -c Do not colorize test output. --traceback STYLE When printing backtraces for errors that occur during tests, print them in the chosen - STYLE. Available styles are "full", which - shows the full function call for each stack - frame on a single line, "crop", which - truncates each stack frame to 80 characters - (the default), and "pretty", which uses - Emacs' pretty-printing facilities to print - each stack frame, and also annotates each - frame with a lambda or M to indicate whether - it is a normal function call or a - macro/special form. + STYLE. Available styles are + "full", which shows the full function call for + each stack frame on a single line, + "crop", which truncates each stack frame to 80 + characters (the default), + "pretty", which uses Emacs' pretty-printing + facilities to print each stack frame, and also + annotates each frame with a lambda or M to + indicate whether it is a normal function call + or a macro/special form and + "omit", which omits the backtraces alltogether. + +--stale-file-error Fail the test run if stale .elc files are loaded. EOF } @@ -70,7 +85,7 @@ do shift shift ;; - "-c"|"--no-color") + "-c"|"--no-color"|"--no-skip"|"--only-error"|"--stale-file-error") BUTTERCUP_ARGS+=("$1") shift ;; @@ -87,4 +102,9 @@ do esac done -exec "$EMACS_BIN" -batch "${EMACS_ARGS[@]}" -l buttercup -f buttercup-run-discover "${BUTTERCUP_ARGS[@]}" +# `--' is needed so that Buttercup options don't get parsed by Emacs itself. +exec "$EMACS_BIN" -batch "${EMACS_ARGS[@]}" -l buttercup -f buttercup-run-discover -- "${BUTTERCUP_ARGS[@]}" + +# Local Variables: +# indent-tabs-mode: nil +# End: diff --git a/bin/buttercup.bat b/bin/buttercup.bat index 092230a..108c910 100644 --- a/bin/buttercup.bat +++ b/bin/buttercup.bat @@ -33,22 +33,37 @@ echo. echo --pattern, -p PATTERN Only run tests with names matching PATTERN. echo This option can be used multiple times, in echo which case tests will be run if they match -echo any of the given patterns. +echo any of the given patterns. PATTERN should be +echo an Emacs regex that will be matched against +echo the full test description (the concatenation +echo of the test and all parent suites +echo descriptions). +echo. +echo --no-skip Do not print the descriptions for tests that +echo are filtered out with "--pattern" or disabled +echo with "xit". Tests skipped wiath "assume" will +echo still be priuted, +echo. +echo --only-error Only print failed tests and their containing suites. +echo Implies "--no-skip". echo. echo --no-color, -c Do not colorize test output. echo. echo --traceback STYLE When printing backtraces for errors that occur echo during tests, print them in the chosen -echo STYLE. Available styles are "full", which -echo shows the full function call for each stack -echo frame on a single line, "crop", which -echo truncates each stack frame to 80 characters -echo ^(the default^), and "pretty", which uses -echo Emacs' pretty-printing facilities to print -echo each stack frame, and also annotates each -echo frame with a lambda or M to indicate whether -echo it is a normal function call or a -echo macro/special form. +echo STYLE. Available styles are +echo "full", which shows the full function call for +echo each stack frame on a single line, +echo "crop", which truncates each stack frame to 80 +echo characters (the default), +echo "pretty", which uses Emacs' pretty-printing +echo facilities to print each stack frame, and also +echo annotates each frame with a lambda or M to +echo indicate whether it is a normal function call +echo or a macro/special form and +echo "omit", which omits the backtraces alltogether. +echo. +echo --stale-file-error Fail the test run if stale .elc files are loaded. exit /b :parse_args @@ -110,6 +125,15 @@ if not [%current_arg%]==[] ( ) else if !current_arg!==--no-color ( set buttercup_args=!buttercup_args! !current_arg! shift /1 + ) else if !current_arg!==--no-skip ( + set buttercup_args=!buttercup_args! !current_arg! + shift /1 + ) else if !current_arg!==--only-error ( + set buttercup_args=!buttercup_args! !current_arg! + shift /1 + ) else if !current_arg!==--stale-file-error ( + set buttercup_args=!buttercup_args! !current_arg! + shift /1 ) else if !current_arg!==--traceback ( set buttercup_args=!buttercup_args! !current_arg! !next_arg! shift /1 diff --git a/buttercup-compat.el b/buttercup-compat.el index d70bd62..792a8c8 100644 --- a/buttercup-compat.el +++ b/buttercup-compat.el @@ -109,6 +109,17 @@ If INCLUDE-DIRECTORIES, also include directories that have matching names." (<= (car here) delay))) (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here))))))) +;;;;;;;;;;;;;;;;;;;;; +;; Introduced in 26.1 + +(unless (fboundp 'file-attribute-modification-time) + (defsubst file-attribute-modification-time (attributes) + "The modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of the last change to the file's contents, and +is a Lisp timestamp in the style of `current-time'." + (nth 5 attributes))) + + (provide 'buttercup-compat) ;;; buttercup-compat.el ends here diff --git a/buttercup-pkg.el b/buttercup-pkg.el index 5b763cb..5d92605 100644 --- a/buttercup-pkg.el +++ b/buttercup-pkg.el @@ -1,2 +1,2 @@ -(define-package "buttercup" "1.22" +(define-package "buttercup" "1.24" "Behavior-Driven Emacs Lisp Testing") diff --git a/buttercup.el b/buttercup.el index 535aa05..0c2f325 100644 --- a/buttercup.el +++ b/buttercup.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2015-2017 Jorgen Schaefer <contact@jorgenschaefer.de> -;; Version: 1.22 +;; Version: 1.24 ;; Author: Jorgen Schaefer <contact@jorgenschaefer.de> ;; Package-Requires: ((emacs "24.3")) ;; URL: https://github.com/jorgenschaefer/emacs-buttercup @@ -56,7 +56,9 @@ The function MUST have one of the following forms: \(lambda () EXPR) +\(lambda () (buttercup--mark-stackframe) EXPR) \(closure (ENVLIST) () EXPR) +\(closure (ENVLIST) () (buttercup--mark-stackframe) EXPR) \(lambda () (quote EXPR) EXPR) \(closure (ENVLIST) () (quote EXPR) EXPR) @@ -65,12 +67,14 @@ forms are useful if EXPR is a macro call, in which case the `quote' ensures access to the un-expanded form." (pcase fun (`(closure ,(pred listp) nil ,expr) expr) + (`(closure ,(pred listp) nil (buttercup--mark-stackframe) ,expr) expr) (`(closure ,(pred listp) nil (quote ,expr) . ,_rest) expr) (`(closure ,(pred listp) nil ,_expr . ,(pred identity)) (error "Closure contains multiple expressions: %S" fun)) (`(closure ,(pred listp) ,(pred identity) . ,(pred identity)) (error "Closure has nonempty arglist: %S" fun)) (`(lambda nil ,expr) expr) + (`(lambda nil (buttercup--mark-stackframe) ,expr) expr) (`(lambda nil (quote ,expr) . ,_rest) expr) (`(lambda nil ,_expr . ,(pred identity)) (error "Function contains multiple expressions: %S" fun)) @@ -132,9 +136,16 @@ This macro knows three forms: \(expect ARG) Fail the current test if ARG is not true." (let ((wrapped-args - (mapcar (lambda (expr) `(lambda () (quote ,expr) ,expr)) args))) + (mapcar (lambda (expr) `(lambda () + (quote ,expr) + (buttercup--mark-stackframe) + ,expr)) + args))) `(buttercup-expect - (lambda () (quote ,arg) ,arg) + (lambda () + (quote ,arg) + (buttercup--mark-stackframe) + ,arg) ,(or matcher :to-be-truthy) ,@wrapped-args))) @@ -632,10 +643,10 @@ See also `buttercup-define-matcher'." (cond ((not calls) (cons nil - (format "Expected `%s' to have been called with %s, but it was not called at all" spy args))) + (format "Expected `%s' to have been called with %S, but it was not called at all" spy args))) ((not (member args calls)) (cons nil - (format "Expected `%s' to have been called with %s, but it was called with %s" + (format "Expected `%s' to have been called with %S, but it was called with %s" spy args (mapconcat (lambda (args) @@ -801,6 +812,18 @@ The indentaion is two spaces per parent." (let ((level (length (buttercup-suite-or-spec-parents suite-or-spec)))) (concat (make-string (* 2 level) ?\s) (buttercup-suite-or-spec-description suite-or-spec)))) +(defun buttercup--spec-mark-pending (spec description &optional description-for-now) + "Mark SPEC as pending with DESCRIPTION. +If DESCRIPTION-FOR-NOW is non-nil, set the spec +`pending-description' to that value for now, it will be reset to +DESCRIPTION when the spec is run. Return SPEC." + (setf (buttercup-spec-function spec) + (lambda () (signal 'buttercup-pending description)) + (buttercup-spec-status spec) 'pending) + (when description-for-now + (setf (buttercup-spec-failure-description spec) description-for-now)) + spec) + ;;;;;;;;;;;;;;;;;;;; ;;; Suites: describe @@ -873,6 +896,7 @@ most probably including one or more calls to `expect'." `(buttercup-it ,description (lambda () (buttercup-with-converted-ert-signals + (buttercup--mark-stackframe) ,@body))) `(buttercup-xit ,description))) @@ -1022,15 +1046,8 @@ A disabled spec is not run. DESCRIPTION has the same meaning as in `xit'. FUNCTION is ignored. Return the created spec object." (declare (indent 1)) - (ignore function) - (let ((spec (buttercup-it description - (lambda () - (signal 'buttercup-pending "PENDING"))))) - (setf (buttercup-spec-status spec) - 'pending - (buttercup-spec-failure-description spec) - "") - spec)) + (let ((spec (buttercup-it description (or function #'ignore)))) + (buttercup--spec-mark-pending spec "PENDING" ""))) ;;;;;;;;; ;;; Spies @@ -1060,7 +1077,9 @@ CURRENT-BUFFER is the buffer that was current when the spy was called. RETURN-VALUE is the returned value, if any. THROWN-SIGNAL is the signal raised by the function, if any. Only one of RETURN-VALUE and THROWN-SIGNAL may be given. Giving -none of them is equivalent to `:return-value nil'." +none of them is equivalent to `:return-value nil'. + +\(fn &key ARGS CURRENT-BUFFER RETURN-VALUE THROWN-SIGNAL)" (cond ((and has-return-value has-thrown-signal) (error "Only one of :return-value and :thrown-signal may be given")) @@ -1306,9 +1325,10 @@ spec-started -- A spec in is starting. The argument is the spec. spec-done -- A spec has finished executing. The argument is the spec. -suite-done -- A suite has finished. The argument is the spec. +suite-done -- A suite has finished. The argument is the suite. -buttercup-done -- All suites have run, the test run is over.") +buttercup-done -- All suites have run, the test run is over. The + argument is the list of executed suites.") (defvar buttercup-stack-frame-style (car '(crop full pretty)) "Style to use when printing stack traces of tests. @@ -1330,6 +1350,9 @@ or a macro/special form.") A buffer with this name should only exist while running a test spec, and should be killed after running the spec.") +;; predeclaration +(defvar buttercup-reporter-batch-quiet-statuses) + ;;;###autoload (defun buttercup-run-at-point () "Run the buttercup suite at point." @@ -1352,6 +1375,8 @@ current directory." (args command-line-args-left)) (while args (cond + ((equal (car args) "--") + (setq args (cdr args))) ((member (car args) '("--traceback")) (when (not (cdr args)) (error "Option requires argument: %s" (car args))) @@ -1368,6 +1393,17 @@ current directory." ((member (car args) '("-c" "--no-color")) (setq buttercup-color nil) (setq args (cdr args))) + ((equal (car args) "--no-skip") + (push 'skipped buttercup-reporter-batch-quiet-statuses) + (push 'disabled buttercup-reporter-batch-quiet-statuses) + (setq args (cdr args))) + ((equal (car args) "--only-error") + (push 'pending buttercup-reporter-batch-quiet-statuses) + (push 'passed buttercup-reporter-batch-quiet-statuses) + (setq args (cdr args))) + ((equal (car args) "--stale-file-error") + (buttercup-error-on-stale-elc) + (setq args (cdr args))) (t (push (car args) dirs) (setq args (cdr args))))) @@ -1375,23 +1411,43 @@ current directory." (dolist (dir (or dirs '("."))) (dolist (file (directory-files-recursively dir "\\`test-.*\\.el\\'\\|-tests?\\.el\\'")) + ;; Exclude any hidden directory, both immediate (^.) and nested (/.) subdirs (when (not (string-match "\\(^\\|/\\)\\." (file-relative-name file))) (load file nil t)))) (when patterns - (buttercup--mark-skipped buttercup-suites patterns)) + (buttercup-mark-skipped patterns t)) (buttercup-run))) -(defun buttercup--mark-skipped (suites patterns) - "Mark any spec in SUITES not matching PATTERNS as skipped. -SUITES is a list of suites. PATTERNS is a list of regexps." +(defun buttercup-mark-skipped (matcher &optional reverse) + "Mark any spec that match MATCHER as skipped. +MATCHER can be either a regex, a list of regexes, or a function +taking a spec as the single argument. If REVERSE is non-nil, +specs will be marked as pending when MATCHER does not match." + (cl-etypecase matcher + (string (buttercup--mark-skipped + buttercup-suites + (lambda (spec) + (string-match matcher (buttercup-spec-full-name spec))) + reverse)) + (function (buttercup--mark-skipped buttercup-suites matcher reverse)) + (list (cond + ((cl-every #'stringp matcher) + (buttercup-mark-skipped (mapconcat (lambda (re) + (concat "\\(?:" re "\\)")) + matcher "\\|") + reverse)) + (t (error "Bad matcher list: %s, should be list of strings" matcher)))))) + +(defun buttercup--mark-skipped (suites predicate &optional reverse-predicate) + "Mark all specs in SUITES as skipped if PREDICATE(spec) is true. +If REVERSE-PREDICATE is non-nil, mark spec where PREDICATE(spec) +is false." (dolist (spec (buttercup--specs suites)) - (let ((spec-full-name (buttercup-spec-full-name spec))) - (unless (cl-dolist (p patterns) - (when (string-match p spec-full-name) - (cl-return t))) - (setf (buttercup-spec-function spec) - (lambda () (signal 'buttercup-pending "SKIPPED")) - (buttercup-spec-status spec) 'pending))))) + ;; cond implements (xor reverse-predicate (funcall predicate + ;; spec)) as xor is introduced in Emacs 27 + (when (cond ((not reverse-predicate) (funcall predicate spec)) + ((not (funcall predicate spec)) reverse-predicate)) + (buttercup--spec-mark-pending spec "SKIPPED")))) ;;;###autoload (defun buttercup-run-markdown-buffer (&rest markdown-buffers) @@ -1440,16 +1496,27 @@ A suite must be defined within a Markdown \"lisp\" code block." ;; Defined below in a dedicated section (defvar buttercup-reporter)) -(defun buttercup-run () - "Run all described suites." +(defun buttercup-run (&optional noerror) + "Run all described suites. +Signal an error if any spec fail or if no suites have been +defined. Signal no errors if NOERROR is non-nil. Return t if all +specs pass, nil if at least one spec fail, and :no-suites if no suites +have been defined." (if buttercup-suites - (progn - (funcall buttercup-reporter 'buttercup-started buttercup-suites) - (mapc #'buttercup--run-suite buttercup-suites) - (funcall buttercup-reporter 'buttercup-done buttercup-suites) - (when (> (buttercup-suites-total-specs-failed buttercup-suites) 0) - (error ""))) - (error "No suites defined"))) + (buttercup--run-suites buttercup-suites noerror) + (or (and noerror :no-suites) + (error "No suites defined")))) + +(defun buttercup--run-suites (suites &optional noerror) + "Run a list of SUITES. +Signal an error if any spec fail. Signal no error if NOERROR is +non-nil. Return t if all specs pass, nil if at least one spec +fail." + (funcall buttercup-reporter 'buttercup-started suites) + (mapc #'buttercup--run-suite suites) + (funcall buttercup-reporter 'buttercup-done suites) + (or (zerop (buttercup-suites-total-specs-failed suites)) + (not (or noerror (error ""))))) (defvar buttercup--before-each nil "A list of functions to call before each spec. @@ -1483,6 +1550,7 @@ Do not change the global value.") (funcall buttercup-reporter 'suite-done suite))) (defun buttercup--run-spec (spec) + "Run SPEC." (buttercup--set-start-time spec) (unwind-protect (progn @@ -1558,9 +1626,7 @@ Calls either `buttercup-reporter-batch' or EVENT and ARG are described in `buttercup-reporter'." (if noninteractive - (if buttercup-color - (buttercup-reporter-batch-color event arg) - (buttercup-reporter-batch event arg)) + (buttercup-reporter-batch event arg) (buttercup-reporter-interactive event arg))) (defvar buttercup-reporter-batch--start-time nil @@ -1569,6 +1635,34 @@ EVENT and ARG are described in `buttercup-reporter'." (defvar buttercup-reporter-batch--failures nil "List of failed specs of the current batch report.") +(defvar buttercup-reporter-batch-quiet-statuses nil + "Do not print results for any spec with any of the listed statuses.") + +(defvar buttercup-reporter-batch--suite-stack nil + "Stack of unprinted suites.") + +(defun buttercup-reporter-batch--quiet-spec-p (spec) + "Return non-nil if the status of SPEC is any of the quiet statuses. +SPEC is considered quiet if its status is listed in +`buttercup-reporter-batch-quiet-statuses'. + +Two special statuses can be listed in +`buttercup-reporter-batch-quiet-statuses'; + `skipped': Real spec status `pending' and failure description \"SKIPPED\". + This matches specs filtered out with `buttercup-mark-skipped'. + `disabled': Real spec status `pending' and failure description \"PENDING\". + This matches specs disabled with `xit' or equivalent." + (or (memq (buttercup-spec-status spec) buttercup-reporter-batch-quiet-statuses) + ;; check for the virtual status `skipped' + (and (memq 'skipped buttercup-reporter-batch-quiet-statuses) + (eq (buttercup-spec-status spec) 'pending) + (string= (buttercup-spec-failure-description spec) "SKIPPED")) + ;; check for the virtual status `disabled' + (and (memq 'disabled buttercup-reporter-batch-quiet-statuses) + (eq (buttercup-spec-status spec) 'pending) + (string= (buttercup-spec-failure-description spec) "PENDING")) + )) + (defun buttercup-reporter-batch (event arg) "A reporter that handles batch sessions. @@ -1578,7 +1672,8 @@ EVENT and ARG are described in `buttercup-reporter'." (pcase event (`buttercup-started (setq buttercup-reporter-batch--start-time (current-time) - buttercup-reporter-batch--failures nil) + buttercup-reporter-batch--failures nil + buttercup-reporter-batch--suite-stack nil) (let ((defined (buttercup-suites-total-specs-defined arg)) (pending (buttercup-suites-total-specs-pending arg))) (if (> pending 0) @@ -1588,158 +1683,143 @@ EVENT and ARG are described in `buttercup-reporter'." (buttercup--print "Running %s specs.\n\n" defined)))) (`suite-started - (buttercup--print "%s\n" (buttercup--indented-description arg))) + (if buttercup-reporter-batch-quiet-statuses + (push arg buttercup-reporter-batch--suite-stack) + (buttercup--print "%s\n" (buttercup--indented-description arg)))) (`spec-started - (buttercup--print "%s" (buttercup--indented-description arg))) + (or buttercup-reporter-batch-quiet-statuses + (and buttercup-color + (string-match-p "[\n\v\f]" (buttercup-spec-description arg))) + (buttercup--print "%s" (buttercup--indented-description arg)))) (`spec-done - (cond - ((eq (buttercup-spec-status arg) 'passed)) ; do nothing - ((eq (buttercup-spec-status arg) 'failed) - (buttercup--print " FAILED") + (when (and buttercup-reporter-batch-quiet-statuses + (not (buttercup-reporter-batch--quiet-spec-p arg))) + (dolist (suite (nreverse buttercup-reporter-batch--suite-stack)) + (buttercup--print "%s\n" (buttercup--indented-description suite))) + (setq buttercup-reporter-batch--suite-stack nil) + (buttercup--print "%s" (buttercup--indented-description arg))) + + (unless (buttercup-reporter-batch--quiet-spec-p arg) + (buttercup-reporter-batch--print-spec-done-line arg buttercup-color)) + + (when (eq (buttercup-spec-status arg) 'failed) (setq buttercup-reporter-batch--failures (append buttercup-reporter-batch--failures - (list arg)))) - ((eq (buttercup-spec-status arg) 'pending) - (buttercup--print " %s" (buttercup-spec-failure-description arg))) - (t - (error "Unknown spec status %s" (buttercup-spec-status arg)))) - (buttercup--print " (%s)\n" (buttercup-elapsed-time-string arg))) + (list arg))))) (`suite-done (when (= 0 (length (buttercup-suite-or-spec-parents arg))) - (buttercup--print "\n"))) + (if buttercup-reporter-batch-quiet-statuses + (unless buttercup-reporter-batch--suite-stack + (buttercup--print "\n")) + (buttercup--print "\n"))) + (pop buttercup-reporter-batch--suite-stack)) (`buttercup-done (dolist (failed buttercup-reporter-batch--failures) - (let ((description (buttercup-spec-failure-description failed)) - (stack (buttercup-spec-failure-stack failed))) - (buttercup--print "%s\n" (make-string 40 ?=)) - (buttercup--print "%s\n" (buttercup-spec-full-name failed)) - (when stack - (buttercup--print "\nTraceback (most recent call last):\n") - (dolist (frame stack) - (let ((frame-text (buttercup--format-stack-frame frame))) - (buttercup--print "%s\n" frame-text)))) - (cond - ((stringp description) - (buttercup--print "FAILED: %s\n" description)) - ((eq (car description) 'error) - (buttercup--print "%S: %S\n\n" - (car description) - (cadr description))) - (t - (buttercup--print "FAILED: %S\n" description))) - (buttercup--print "\n"))) - (let ((defined (buttercup-suites-total-specs-defined arg)) - (pending (buttercup-suites-total-specs-pending arg)) - (failed (buttercup-suites-total-specs-failed arg)) - (duration (float-time (time-subtract - (current-time) - buttercup-reporter-batch--start-time)))) - (if (> pending 0) - (buttercup--print - "Ran %s out of %s specs, %s failed, in %s.\n" - (- defined pending) - defined - failed - (seconds-to-string duration)) - (buttercup--print "Ran %s specs, %s failed, in %s.\n" - defined - failed - (seconds-to-string duration))))) + (buttercup-reporter-batch--print-failed-spec-report failed buttercup-color)) + (buttercup-reporter-batch--print-summary arg buttercup-color)) (_ (error "Unknown event %s" event))))) -(defun buttercup-reporter-batch-color (event arg) - "A reporter that handles batch sessions. - -Compared to `buttercup-reporter-batch', this reporter uses -colors. - -EVENT and ARG are described in `buttercup-reporter'." - (pcase event - (`spec-started - (unless (string-match-p "[\n\v\f]" (buttercup-spec-description arg)) - (buttercup-reporter-batch event arg))) - (`spec-done - ;; Carriage returns (\r) should not be colorized. It would mess - ;; up color handling in Emacs compilation buffers using - ;; `ansi-color-apply-on-region' in `compilation-filter-hook'. - (pcase (buttercup-spec-status arg) - (`passed - (buttercup--print - "\r%s" (buttercup-colorize (buttercup--indented-description arg) 'green))) - (`failed - (buttercup--print - "\r%s" (buttercup-colorize - (concat (buttercup--indented-description arg) " FAILED") - 'red)) - (setq buttercup-reporter-batch--failures - (append buttercup-reporter-batch--failures - (list arg)))) - (`pending - (if (equal (buttercup-spec-failure-description arg) "SKIPPED") - (buttercup--print " %s" (buttercup-spec-failure-description arg)) - (buttercup--print - "\r%s" (buttercup-colorize - (concat (buttercup--indented-description arg) " " - (buttercup-spec-failure-description arg)) - 'yellow)))) - (_ - (error "Unknown spec status %s" (buttercup-spec-status arg)))) - (buttercup--print " (%s)\n" (buttercup-elapsed-time-string arg))) - - (`buttercup-done - (dolist (failed buttercup-reporter-batch--failures) - (let ((description (buttercup-spec-failure-description failed)) - (stack (buttercup-spec-failure-stack failed))) - (buttercup--print "%s\n" (make-string 40 ?=)) - (buttercup--print (buttercup-colorize "%s\n" 'red) (buttercup-spec-full-name failed)) - (when stack - (buttercup--print "\nTraceback (most recent call last):\n") - (dolist (frame stack) - (let ((frame-text (buttercup--format-stack-frame frame))) - (buttercup--print "%s\n" frame-text)))) - (cond - ((stringp description) - (buttercup--print (concat (buttercup-colorize "FAILED" 'red ) ": %s\n") - description)) - ((eq (car description) 'error) - (buttercup--print "%S: %S\n\n" - (car description) - (cadr description))) - (t - (buttercup--print "FAILED: %S\n" description))) - (buttercup--print "\n"))) - (let ((defined (buttercup-suites-total-specs-defined arg)) - (pending (buttercup-suites-total-specs-pending arg)) - (failed (buttercup-suites-total-specs-failed arg)) - (duration (float-time (time-subtract (current-time) - buttercup-reporter-batch--start-time)))) - (if (> pending 0) - (buttercup--print - (concat - "Ran %s out of %s specs," - (buttercup-colorize " %s failed" (if (eq 0 failed) 'green 'red)) - ", in %s.\n") - (- defined pending) - defined - failed - (seconds-to-string duration)) - (buttercup--print - (concat - "Ran %s specs," - (buttercup-colorize " %s failed" (if (eq 0 failed) 'green 'red)) - ", in %s.\n") - defined - failed - (seconds-to-string duration))))) - - (_ - ;; Fall through to buttercup-reporter-batch implementation. - (buttercup-reporter-batch event arg))) - ) +(defun buttercup-reporter-batch--print-spec-done-line (spec color) + "Print the remainder of the SPEC report line for `spec-done'. + +If COLOR is non-nil, erace the text so far on the current line +using '\r' and replace it with the same text colored according to +the SPEC status. Do not erase and replace if the text would have +been reprinted with the default color. + +Then print the SPEC failure description except if the status is +`passed'. If COLOR is non-nil, print it in the aproprate color +for the spec status. + +Finally print the elapsed time for SPEC." + (let* ((status (buttercup-spec-status spec)) + (failure (buttercup-spec-failure-description spec))) + ;; Failed specs do typically not have string filure-descriptions. + ;; In this typical case, use the string "FAILED" for the output. + (and (eq status 'failed) + (not (stringp failure)) + (setq failure "FAILED")) + (unless (memq status '(passed pending failed)) + (error "Unknown spec status %s" status)) + ;; Special status in this function; + ;; skipped - a pending spec with failure description "SKIPPED". + (and (eq status 'pending) + (equal failure "SKIPPED") + (setq status 'skipped)) + ;; Use color both as a boolean for erase-and-reprint and the color + ;; to use. nil means the default color. + (setq color (and color (pcase status + (`passed 'green) + (`pending 'yellow) + (`failed 'red) + (`skipped nil)))) + (when color + ;; Carriage returns (\r) should not be colorized. It would mess + ;; up color handling in Emacs compilation buffers using + ;; `ansi-color-apply-on-region' in `compilation-filter-hook'. + (buttercup--print "\r%s" + (buttercup-colorize + (buttercup--indented-description spec) color))) + (unless (eq 'passed status) + (buttercup--print "%s" + (buttercup-colorize (concat " " failure) color))) + (buttercup--print " (%s)\n" (buttercup-elapsed-time-string spec)))) + +(cl-defun buttercup-reporter-batch--print-failed-spec-report (failed-spec color) + "Print a failure report for FAILED-SPEC. + +Colorize parts of the output if COLOR is non-nil." + (when (eq buttercup-stack-frame-style 'omit) + (cl-return-from buttercup-reporter-batch--print-failed-spec-report)) + (let ((description (buttercup-spec-failure-description failed-spec)) + (stack (buttercup-spec-failure-stack failed-spec)) + (full-name (buttercup-spec-full-name failed-spec))) + (if color + (setq full-name (buttercup-colorize full-name 'red))) + (buttercup--print "%s\n" (make-string 40 ?=)) + (buttercup--print "%s\n" full-name) + (when stack + (buttercup--print "\nTraceback (most recent call last):\n") + (dolist (frame stack) + (let ((frame-text (buttercup--format-stack-frame frame))) + (buttercup--print "%s\n" frame-text)))) + (cond + ((stringp description) + (buttercup--print "%s: %s\n" + (if color + (buttercup-colorize "FAILED" 'red) + "FAILED") + description)) + ((and (consp description) (eq (car description) 'error)) + (buttercup--print "%S: %S\n" + (car description) + (cadr description))) + (t + (buttercup--print "FAILED: %S\n" description))) + (buttercup--print "\n"))) + +(defun buttercup-reporter-batch--print-summary (suites color) + "Print a summary of the reults of SUITES. + +Colorize parts of the output if COLOR is non-nil." + (let* ((defined (buttercup-suites-total-specs-defined suites)) + (pending (buttercup-suites-total-specs-pending suites)) + (failed (buttercup-suites-total-specs-failed suites)) + (duration (seconds-to-string + (float-time + (time-subtract (current-time) + buttercup-reporter-batch--start-time)))) + (out-of (if (zerop pending) "" (format " out of %d" defined))) + (failed-str (format "%d failed" failed))) + (if color + (setq failed-str (buttercup-colorize failed-str (if (zerop failed) 'green 'red)))) + (buttercup--print + "Ran %d%s specs, %s, in %s.\n" + (- defined pending) out-of failed-str duration))) (defun buttercup--print (fmt &rest args) "Format a string and send it to terminal without alteration. @@ -1795,9 +1875,12 @@ the capturing behavior." ,@body)) (defun buttercup-colorize (string color) - "Format STRING with COLOR." - (let ((color-code (cdr (assoc color buttercup-colors)))) - (format "\e[%sm%s\e[0m" color-code string))) + "Format STRING with COLOR. +Return STRING unmodified if COLOR is nil." + (if color + (let ((color-code (cdr (assoc color buttercup-colors)))) + (format "\e[%sm%s\e[0m" color-code string)) + string)) (defun buttercup-reporter-interactive (event arg) "Reporter for interactive sessions. @@ -1847,34 +1930,62 @@ failed -- The second value is the description of the expectation nil)))) (defun buttercup--debugger (&rest args) + "Debugger function that return error context with an exception. + +ARGS according to `debugger'." ;; If we do not do this, Emacs will not run this handler on ;; subsequent calls. Thanks to ert for this. (setq num-nonmacro-input-events (1+ num-nonmacro-input-events)) (throw 'buttercup-debugger-continue (list 'failed args (buttercup--backtrace)))) +(defalias 'buttercup--mark-stackframe 'ignore + "Marker to find where the backtrace start.") + (defun buttercup--backtrace () - (let* ((n 0) - (frame (backtrace-frame n)) - (frame-list nil) - (in-program-stack nil)) - (while frame + "Create a backtrace, a list of frames returned from `backtrace-frame'." + ;; Read the backtrace frames from 0 (the closest) upward. + (cl-do* ((n 0 (1+ n)) + (frame (backtrace-frame n) (backtrace-frame n)) + (frame-list nil) + (in-program-stack nil)) + ((not frame) frame-list) + ;; discard frames until (and including) `buttercup--debugger', they + ;; only contain buttercup code (when in-program-stack (push frame frame-list)) (when (eq (elt frame 1) 'buttercup--debugger) (setq in-program-stack t)) - (when (eq (elt frame 1) - 'buttercup--funcall) - (setq in-program-stack nil - frame-list (nthcdr 6 frame-list))) - (setq n (1+ n) - frame (backtrace-frame n))) - frame-list)) + ;; keep frames until one of the known functions are found, after + ;; this is just the buttercup framework and not interesting for + ;; users incorrect for testing buttercup. Some frames before the + ;; function also have to be discarded + (cl-labels ((tree-find (key tree) + (cl-block tree-find + (while (consp tree) + (let ((elem (pop tree))) + (when (or (and (consp elem) + (tree-find key elem)) + (eql key elem)) + (cl-return-from tree-find t)))) + (cl-return-from tree-find + (and tree (eql tree key)))))) + (when (and in-program-stack (tree-find 'buttercup--mark-stackframe frame)) + (pop frame-list) + (cl-return frame-list))))) (defun buttercup--format-stack-frame (frame &optional style) - (pcase (or style buttercup-stack-frame-style 'crop) - (`full (format " %S" (cdr frame))) + "Format stack FRAME according to STYLE. +STYLE can be one of `full', `crop', `pretty', or `omit'. +If STYLE is nil, use `buttercup-stack-frame-style' or `crop'." + (setq style (or style buttercup-stack-frame-style 'crop)) + (pcase style + (`omit) ; needed to verify valid styles + (`full + (if (car frame) + (format " %S%s" (cadr frame) (if (cddr frame) (prin1-to-string (cddr frame)) "()")) + (format " %S" (cdr frame)))) (`crop (let ((line (buttercup--format-stack-frame frame 'full))) ;; Note: this could be done sith `s-truncate' from the s @@ -1941,6 +2052,32 @@ With buttercup minor mode active the following is activated: (cl-dolist (form imenu-forms) (setq imenu-generic-expression (delete form imenu-generic-expression)))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Signal errors when files have to be recompiled + +(defun buttercup-check-for-stale-elc (elc-file) + "Raise an error when ELC-FILE is an elc-file and older than its el-file." + (when (string= (file-name-extension elc-file) "elc") + (let ((el-file (substring elc-file 0 -1))) + (when (and (file-exists-p el-file) + (time-less-p + (file-attribute-modification-time (file-attributes elc-file)) + (file-attribute-modification-time (file-attributes el-file)))) + (error "%s is newer than %s" el-file elc-file))))) + +(defun buttercup-error-on-stale-elc (&optional arg) + "Activate errors when an stale (older than .el) .elc-file is loaded. + +Enable the functionality if ARG is omitted or nil, toggle it if +ARG is ‘toggle’; disable otherwise." + (cond ((null arg) + (add-hook 'after-load-functions #'buttercup-check-for-stale-elc)) + ((eq arg 'toggle) + (if (memq 'buttercup-check-for-stale-elc after-load-functions) + (remove-hook 'after-load-functions #'buttercup-check-for-stale-elc) + (add-hook 'after-load-functions #'buttercup-check-for-stale-elc))) + (t (remove-hook 'after-load-functions #'buttercup-check-for-stale-elc)))) + ;; Local Variables: ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil diff --git a/docs/running-tests.md b/docs/running-tests.md index 8bebdec..4ce580d 100644 --- a/docs/running-tests.md +++ b/docs/running-tests.md @@ -16,7 +16,7 @@ only those, and test your project in a well-defined environment. Buttercup works best in such environments, so the following best practices rely on Cask to be installed. -## Project Directory Layout +### Project Directory Layout A basic project layout requires a project file, called `feature.el` here, a `Cask` file to define dependencies, and a `tests/` directory @@ -30,7 +30,7 @@ feature/feature.el **feature.el** -```Lisp +```Emacs-Lisp (defun featurize (bug feature) (format "It's not a %s, it's a %s" bug feature)) @@ -59,7 +59,7 @@ feature/feature.el "It's not a bug, it's a feature"))) ``` -## Running Tests +### Running Tests You can now use Cask to run your tests. @@ -100,11 +100,71 @@ named `test-*.el`, `*-test.el` or `*-tests.el`. Use the `--pattern PATTERN` option to only Only run tests with names matching PATTERN. The `--pattern` option can be used multiple times, in which case tests will be run if they match any of the given -patterns. +patterns. Combine with the `--no-skip` option to filter out the +skipped tests. You can run this command whichever way you like. Common choices include a makefile or shell scripts. +## Eldev + +[Eldev](https://github.com/doublep/eldev) is another Elisp build tool +and has built-in supports for Buttercup. Like Cask, it installs +dependencies of your project automatically, ensuring consistent +environment. + +### Project Directory Layout + +Typical project layout used for Cask also works for Eldev. However, +the tool is very liberal and with a couple of lines you can configure +it to handle almost any layout a project could have (see [its +documentation](https://github.com/doublep/eldev#testing) if needed). + +Unlike Cask, however, Eldev needs that your test files include form +`(require 'buttercup)`. Otherwise you will get Elisp errors like +“Symbol’s function definition is void: describe”. Basically, Eldev +requires that the `.el` files are *self-contained* and do not depend +on certain external tool. + +### Running Tests + +The tool installs project dependencies automatically when needed, so +you don’t have to bother about that. All you need to do is to ensure +the main file of the project correctly declares them. + +You also don’t need to declare that the project uses Buttercup for +testing: Eldev will determine that on-the-fly. + +To run your test, just execute: + +```` +$ eldev test +[1/1] Installing package ‘buttercup’ (1.23) from ‘melpa-stable’... +Running 1 specs. + +The feature + can use bug and feature (2.58ms) + +Ran 1 specs, 0 failed, in 2.68ms. +```` + +You can also specify patterns on the command line, to avoid running +all the tests at once, i.e.: + +```` +$ eldev test foo +```` + +If you have several test files, you can avoid running all the tests by +specifying filename after `-f` (`--file`) option: + +```` +$ eldev test -f main.el +```` + +For more information, please see tool’s own documentation, especially +[the section about testing](https://github.com/doublep/eldev#testing). + ## Projectile If you use [Projectile](https://github.com/bbatsov/projectile) for interacting with your projects you can set the "default" project test command to be available when you invoke `projectile-test-project`. Create a `.dir-locals.el` file in the the root of your project tree (next to your Cask file). An example: @@ -119,6 +179,9 @@ If you use [Projectile](https://github.com/bbatsov/projectile) for interacting w projectile-test-cmd-map)))))) ``` +If you are using Eldev as build tool, Projectile should provide +testing command on its own, so you don’t need any special steps. + ## Travis If your project is hosted on github, you can use @@ -147,3 +210,23 @@ script: Most of the complexity here is from installing [EVM](https://github.com/rejeep/evm) and Cask to be able to test your project using different Emacs versions. + +For Eldev, use the following `.travis.yml` file: + +```` +language: emacs-lisp +dist: trusty + +env: + # Add more lines like this if you want to test on different Emacs versions. + - EVM_EMACS=emacs-26.3-travis + +install: + - curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/travis-eldev-and-evm > x.sh && source ./x.sh + - evm install $EVM_EMACS --use + +script: + - eldev -p -dtT test +```` + +For details, see [tool’s own documentation](https://github.com/doublep/eldev#continuous-integration). diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el index cb472d3..bda3e6f 100644 --- a/tests/test-buttercup.el +++ b/tests/test-buttercup.el @@ -28,6 +28,7 @@ (require 'ansi-color) (require 'ert) (require 'cl-lib) +(require 'imenu) (defun make-list-of-closures (items) "For each element of ITEMS, return a closure returning it." @@ -36,18 +37,65 @@ items)) (defmacro with-local-buttercup (&rest body) - "Execute BODY with local buttercup state variables." + "Execute BODY with local buttercup state variables. +Keyword arguments kan be used to override the values of certain +variables: + :color -> `buttercup-color' + :frame-style -> `buttercup-stack-frame-style' + :reporter -> `buttercup-reporter' + :suites -> `buttercup-suites' + :quiet -> `buttercup-reporter-batch-quiet-statuses' +\n(fn &keys COLOR SUITES REPORTER &rest BODY)" (declare (debug t) (indent defun)) - `(let (buttercup--after-all - buttercup--after-each - buttercup--before-all + ;; extract keyword arguments + (let ((keys '(:color buttercup-color + :frame-style buttercup-stack-frame-style + :reporter buttercup-reporter + :suites buttercup-suites + :quiet buttercup-reporter-batch-quiet-statuses)) + extra-vars) + (while (plist-member keys (car body)) + (push (list (plist-get keys (pop body)) (pop body)) extra-vars)) + `(let (buttercup--after-each buttercup--before-each (buttercup--cleanup-functions :invalid) buttercup--current-suite (buttercup-reporter #'ignore) buttercup-suites - (buttercup-warning-buffer-name " *ignored buttercup warnings*")) - ,@body)) + buttercup-color + buttercup-reporter-batch-quiet-statuses + buttercup-reporter-batch--suite-stack + buttercup-reporter-batch--failures + (buttercup-stack-frame-style 'crop) + (buttercup-warning-buffer-name " *ignored buttercup warnings*") + ,@(nreverse extra-vars)) + ,@body))) + +(defmacro buttercup--test-with-tempdir (files &rest body) + "Create FILES and execute BODY in a temporary directory. +FILES shall be a list of file names. An empty file with that name +will be created in the temporary directory. Any path prefix for a +file will be created in the temporary directory." + (declare (debug t) (indent defun)) + (let ((tmproot (cl-gensym)) + (subdir (cl-gensym)) + (olddir (cl-gensym)) + (file (cl-gensym))) + `(let ((,tmproot (make-temp-file "buttercup-test-temp-" t)) + ,subdir + (,olddir default-directory)) + (dolist (,file ,files) + (setq ,subdir (concat ,tmproot "/" (file-name-directory ,file))) + (when (and ,subdir (not (file-exists-p ,subdir))) + (make-directory ,subdir t)) + (write-region "" nil (concat ,tmproot "/" ,file))) + ;; It is tempting to use unwind-protect or condition-case here, + ;; but that will mask actual test failures by interfering with + ;; the debugger installed by buttercup + (cd ,tmproot) + ,@body + (cd ,olddir) + (delete-directory ,tmproot t)))) (defun send-string-to-ansi-buffer (buffer string) "A `send-string-to-terminal' variant that sends STRING to BUFFER. @@ -114,8 +162,10 @@ text properties using `ansi-color-apply'." (expect (length expansion) :to-equal 4) (expect (nth 0 expansion) :to-be 'buttercup-expect) (expect (functionp (nth 1 expansion))) + (expect (buttercup--wrapper-fun-p (nth 1 expansion))) (expect (nth 2 expansion) :to-be :to-equal) - (expect (functionp (nth 3 expansion))))) + (expect (functionp (nth 3 expansion))) + (expect (buttercup--wrapper-fun-p (nth 3 expansion))))) (it "with no matcher should use `:to-be-truthy' as the matcher" (let ((expansion (macroexpand '(expect (equal (+ 1 1) 2))))) @@ -280,7 +330,7 @@ text properties using `ansi-color-apply'." (buttercup-suite-add-child grandparent parent) (buttercup-suite-add-child parent child) - (expect (buttercup-suite-parents child) + (expect (buttercup-suite-or-spec-parents child) :to-equal (list parent grandparent))))) @@ -292,7 +342,7 @@ text properties using `ansi-color-apply'." (buttercup-suite-add-child grandparent parent) (buttercup-suite-add-child parent child) - (expect (buttercup-spec-parents child) + (expect (buttercup-suite-or-spec-parents child) :to-equal (list parent grandparent))))) @@ -327,8 +377,8 @@ text properties using `ansi-color-apply'." (expect (buttercup-suites-total-specs-pending suites) :to-equal 2))) (it "should also count skipped specs" - (with-local-buttercup - (buttercup--mark-skipped suites (list "skipped")) + (with-local-buttercup :suites suites + (buttercup-mark-skipped "skipped" t) (expect (buttercup-suites-total-specs-pending suites) :to-equal 3)))) @@ -538,6 +588,7 @@ text properties using `ansi-color-apply'." '(buttercup-it "description" (lambda () (buttercup-with-converted-ert-signals + (buttercup--mark-stackframe) body))))) (it "without argument should expand to xit." @@ -816,7 +867,7 @@ text properties using `ansi-color-apply'." (let ((suite (describe "A bad spy scope" (before-all (spy-on 'some-function))))) - (expect (run--suite suite) + (expect (buttercup--run-suite suite) :to-throw)))) (it "used directly in describe" (with-local-buttercup @@ -1100,43 +1151,47 @@ text properties using `ansi-color-apply'." (setq skipped (make-buttercup-spec :description "skipped" :status 'pending))) (it "should print the number of specs" - (let ((buttercup-reporter-batch--failures nil)) + (with-local-buttercup :color nil (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 specs.\n\n")) (it "should color-print the number of specs with the default color" - (let (buttercup-reporter-batch--failures) - (buttercup-reporter-batch-color 'buttercup-started (list parent-suite))) + (with-local-buttercup :color t + (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 specs.\n\n")) (it "should print the number of skipped specs" - (let ((buttercup-reporter-batch--failures nil)) + (with-local-buttercup :color nil (buttercup-suite-add-child child-suite skipped) (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 out of 2 specs.\n\n")) (it "should color-print the number of skipped specs with the default color" - (let (buttercup-reporter-batch--failures) + (with-local-buttercup :color t (buttercup-suite-add-child child-suite skipped) - (buttercup-reporter-batch-color 'buttercup-started (list parent-suite))) + (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 out of 2 specs.\n\n"))) (describe "on the suite-started event" (it "should emit an indented suite description" - (buttercup-reporter-batch 'suite-started child-suite) + (with-local-buttercup :color nil + (buttercup-reporter-batch 'suite-started child-suite)) (expect (buttercup-output) :to-equal-including-properties " child-suite\n")) (it "should color-print an indented suite description with the default color" - (buttercup-reporter-batch-color 'suite-started child-suite) + (with-local-buttercup :color t + (buttercup-reporter-batch 'suite-started child-suite)) (expect (buttercup-output) :to-equal-including-properties " child-suite\n"))) (describe "on the spec-started event" (it "should emit an indented spec description" - (buttercup-reporter-batch 'spec-started spec) + (with-local-buttercup :color nil + (buttercup-reporter-batch 'spec-started spec)) (expect (buttercup-output) :to-equal-including-properties " spec")) (it "should color-print an indented spec description with the default color" - (buttercup-reporter-batch-color 'spec-started spec) + (with-local-buttercup :color t + (buttercup-reporter-batch 'spec-started spec)) (expect (buttercup-output) :to-equal-including-properties " spec"))) (describe "on the spec-done event" @@ -1147,15 +1202,17 @@ text properties using `ansi-color-apply'." (buttercup--set-end-time spec)) (it "should print no status tag" - (buttercup-reporter-batch 'spec-started spec) - (buttercup-reporter-batch 'spec-done spec) + (with-local-buttercup :color nil + (buttercup-reporter-batch 'spec-started spec) + (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (format " spec (%s)\n" (buttercup-elapsed-time-string spec)))) (it "should color-print the description in green and no status tag" - (buttercup-reporter-batch-color 'spec-started spec) - (buttercup-reporter-batch-color 'spec-done spec) + (with-local-buttercup :color t + (buttercup-reporter-batch 'spec-started spec) + (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[32m spec\e[0m (%s)\n" @@ -1163,16 +1220,18 @@ text properties using `ansi-color-apply'." (it "should print multiline specs cleanly" (setf (buttercup-spec-description spec) "one\ntwo\vthree") - (buttercup-reporter-batch 'spec-started spec) - (buttercup-reporter-batch 'spec-done spec) + (with-local-buttercup :color nil + (buttercup-reporter-batch 'spec-started spec) + (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (format " one\ntwo\n three (%s)\n" (buttercup-elapsed-time-string spec)))) (it "should color-print multiline specs cleanly" (setf (buttercup-spec-description spec) "one\ntwo\vthree") - (buttercup-reporter-batch-color 'spec-started spec) - (buttercup-reporter-batch-color 'spec-done spec) + (with-local-buttercup :color t + (buttercup-reporter-batch 'spec-started spec) + (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[32m one\ntwo\n three\e[0m (%s)\n" @@ -1185,7 +1244,7 @@ text properties using `ansi-color-apply'." (buttercup--set-end-time spec)) (it "should say FAILED" - (let ((buttercup-reporter-batch--failures nil)) + (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties @@ -1193,9 +1252,9 @@ text properties using `ansi-color-apply'." (buttercup-elapsed-time-string spec)))) (it "should color-print the description in red and say FAILED" - (let ((buttercup-reporter-batch--failures nil)) - (buttercup-reporter-batch-color 'spec-started spec) - (buttercup-reporter-batch-color 'spec-done spec)) + (with-local-buttercup :color t + (buttercup-reporter-batch 'spec-started spec) + (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[31m spec FAILED\e[0m (%s)\n" @@ -1209,7 +1268,7 @@ text properties using `ansi-color-apply'." (buttercup--set-end-time spec)) (it "should output the failure-description" - (let ((buttercup-reporter-batch--failures nil)) + (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties @@ -1217,34 +1276,44 @@ text properties using `ansi-color-apply'." (buttercup-elapsed-time-string spec)))) (it "should color-print the description and failure-description in yellow" - (let ((buttercup-reporter-batch--failures nil)) - (buttercup-reporter-batch-color 'spec-started spec) - (buttercup-reporter-batch-color 'spec-done spec)) + (with-local-buttercup :color t + (buttercup-reporter-batch 'spec-started spec) + (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[33m spec DESCRIPTION\e[0m (%s)\n" (buttercup-elapsed-time-string spec)))))) - (it "should throw an error for an unknown spec status" - (setf (buttercup-spec-status spec) 'unknown) - (expect (buttercup-reporter-batch 'spec-done spec) - :to-throw))) + (describe "should throw an error for an unknown spec status" + (before-each (setf (buttercup-spec-status spec) 'unknown)) + (it "for plain output" + (with-local-buttercup :color nil + (expect (buttercup-reporter-batch 'spec-done spec) + :to-throw))) + (it "for colored output" + (with-local-buttercup :color t + (expect (buttercup-reporter-batch 'spec-done spec) + :to-throw))))) (describe "on the suite-done event" - (it "should emit a newline at the end of the top-level suite" - (buttercup-reporter-batch 'suite-done parent-suite) + (it "should emit a newline at the end of a top-level suite" + (with-local-buttercup :color nil + (buttercup-reporter-batch 'suite-done parent-suite)) (expect (buttercup-output) :to-equal-including-properties "\n")) - (it "should color-print a newline at the end of the top-level suite" - (buttercup-reporter-batch-color 'suite-done parent-suite) + (it "should color-print a newline at the end of a top-level suite" + (with-local-buttercup :color t + (buttercup-reporter-batch 'suite-done parent-suite)) (expect (buttercup-output) :to-equal-including-properties "\n")) (it "should not emit anything at the end of other suites" - (buttercup-reporter-batch 'suite-done child-suite) + (with-local-buttercup :color nil + (buttercup-reporter-batch 'suite-done child-suite)) (expect (buttercup-output) :to-equal-including-properties "")) (it "should not color-print anything at the end of other suites" - (buttercup-reporter-batch-color 'suite-done child-suite) + (with-local-buttercup :color t + (buttercup-reporter-batch 'suite-done child-suite)) (expect (buttercup-output) :to-equal-including-properties ""))) (describe "on the buttercup-done event" @@ -1253,60 +1322,59 @@ text properties using `ansi-color-apply'." (before-each (setq defined-specs 10 pending-specs 0 failed-specs 0) - (spy-on 'buttercup-suites-total-specs-defined :and-call-fake (lambda (&rest a) defined-specs)) - (spy-on 'buttercup-suites-total-specs-pending :and-call-fake (lambda (&rest a) pending-specs)) - (spy-on 'buttercup-suites-total-specs-failed :and-call-fake (lambda (&rest a) failed-specs))) + (spy-on 'buttercup-suites-total-specs-defined :and-call-fake (lambda (&rest _) defined-specs)) + (spy-on 'buttercup-suites-total-specs-pending :and-call-fake (lambda (&rest _) pending-specs)) + (spy-on 'buttercup-suites-total-specs-failed :and-call-fake (lambda (&rest _) failed-specs))) (it "should print a summary of run and failing specs" (setq failed-specs 6) - (let (buttercup-reporter-batch--failures) + (with-local-buttercup :color nil (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 10 specs, 6 failed, in [0-9]+.[0-9]+[mu]?s.\n")) (it "should color-print `0 failed' specs in green" - (let (buttercup-reporter-batch--failures) - (buttercup-reporter-batch-color 'buttercup-done nil)) + (with-local-buttercup :color t + (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 10 specs, 0 failed, in [0-9]+.[0-9]+[mu]?s.\n") (expect (substring (buttercup-output) 0 (length "Ran 10 specs, 0 failed, in")) :to-equal-including-properties - (ansi-color-apply "Ran 10 specs,\e[32m 0 failed\e[0m, in"))) + (ansi-color-apply "Ran 10 specs, \e[32m0 failed\e[0m, in"))) (it "should color-print `X failed' specs in red" (setq failed-specs 6) - (let (buttercup-reporter-batch--failures) - (buttercup-reporter-batch-color 'buttercup-done nil)) + (with-local-buttercup :color t + (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 10 specs, 6 failed, in [0-9]+.[0-9]+[mu]?s.\n") (expect (substring (buttercup-output) 0 (length "Ran 10 specs, 6 failed, in")) :to-equal-including-properties - (ansi-color-apply "Ran 10 specs,\e[31m 6 failed\e[0m, in"))) + (ansi-color-apply "Ran 10 specs, \e[31m6 failed\e[0m, in"))) (it "should print a summary separating run and pending specs" (setq pending-specs 3) - (let (buttercup-reporter-batch--failures) + (with-local-buttercup :color nil (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 7 out of 10 specs, 0 failed, in [0-9]+.[0-9]+[mu]?s.\n")) (it "should color-print pending spec count in default color" (setq pending-specs 3) - (let (buttercup-reporter-batch--failures) + (with-local-buttercup :color t (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 7 out of 10 specs, 0 failed, in [0-9]+.[0-9]+[mu]?s.\n") (expect (substring (buttercup-output) - 0 (length "Ran 7 out of 10 specs, 0 failed, in")) + 0 (length "Ran 7 out of 10 specs")) :to-equal-including-properties - "Ran 7 out of 10 specs, 0 failed, in")) + "Ran 7 out of 10 specs")) (it "should not raise any error even if a spec failed" (setf (buttercup-spec-status spec) 'failed) - (let (buttercup-reporter-batch--failures) + (with-local-buttercup :color nil (expect (buttercup-reporter-batch 'buttercup-done (list spec)) :not :to-throw))) - ;; TODO: Backtrace tests ) (describe "on an unknown event" @@ -1314,42 +1382,358 @@ text properties using `ansi-color-apply'." (expect (buttercup-reporter-batch 'unknown-event nil) :to-throw))))) +(describe "Backtraces" + :var (print-buffer) + ;; redirect output to a buffer + (before-each + (setq print-buffer (generate-new-buffer "*btrcp-reporter-test*")) + (spy-on 'send-string-to-terminal :and-call-fake + (apply-partially #'send-string-to-ansi-buffer print-buffer)) + ;; Convenience function + (spy-on 'buttercup-output :and-call-fake + (lambda () + "Return the text of print-buffer." + (with-current-buffer print-buffer + (buffer-string))))) + (after-each + (kill-buffer print-buffer) + (setq print-buffer nil)) + ;; define a buttercup-reporter-batch variant that only outputs on + ;; buttercup-done + (before-each + (spy-on 'backtrace-reporter :and-call-fake + (lambda (event arg) + (if (eq event 'buttercup-done) + (buttercup-reporter-batch event arg) + (cl-letf (((symbol-function 'buttercup--print) #'ignore)) + (buttercup-reporter-batch event arg)))))) + ;; suppress the summary line + (before-each + (spy-on 'buttercup-reporter-batch--print-summary)) + ;; define a known backtrace with a typical error + (before-all + (defun bc-bt-foo (a) (bc-bt-bar a)) + (defun bc-bt-bar (a) (bc-bt-baz a)) + (defun bc-bt-baz (a) + (or (number-or-marker-p a) + (signal 'wrong-type-argument `(number-or-marker-p ,a))))) + (after-all + (fmakunbound 'bc-bt-foo) + (fmakunbound 'bc-bt-bar) + (fmakunbound 'bc-bt-baz)) + (it "should be printed for each failed spec" + (with-local-buttercup + :reporter #'backtrace-reporter + (describe "suite" + (it "expect 2" (expect (+ 1 2) :to-equal 2)) + (it "expect nil" (expect nil))) + (buttercup-run :noerror)) + (expect (buttercup-output) :to-match + (rx string-start + (= 2 (seq (= 40 ?=) "\n" + "suite expect " (or "2" "nil") "\n" + "\n" + "Traceback (most recent call last):\n" + (* (seq " " (+ not-newline) "\n")) + (or "FAILED" "error") ": " (+ not-newline) "\n\n")) + string-end))) + (describe "with style" + :var (test-suites long-string) + ;; Set up tests to test + (before-each + (setq long-string + ;; It's important that this string doesn't contain any + ;; regex special characters, it's used in a `rx' `eval' + ;; form that will escape them. Later Emacsen have + ;; `literal' that is much easier to use. + "a string that will be truncated in backtrace crop, at least 70 chars long") + (with-local-buttercup + (describe "suite" + (it "bc-bt-backtrace" + (expect + (bc-bt-foo long-string) + :to-be-truthy))) + (setq test-suites buttercup-suites))) + (it "`crop' should print truncated lines" + (with-local-buttercup + :suites test-suites :reporter #'backtrace-reporter + :frame-style 'crop + (buttercup-run :noerror) + (setq long-string (truncate-string-to-width long-string 63)) + (expect (buttercup-output) :to-match + (rx-to-string + `(seq + string-start + (= 40 ?=) "\n" + "suite bc-bt-backtrace\n" + "\n" + "Traceback (most recent call last):\n" + " bc-bt-foo(\"" (eval ,long-string) "...\n" + " bc-bt-bar(\"" (eval ,long-string) "...\n" + " bc-bt-baz(\"" (eval ,long-string) "...\n" + (* (seq " " (or (seq (= 74 not-newline) (= 3 ?.)) + (seq (** 0 74 not-newline) (= 3 (not (any ?.))))) "\n")) + "error: (" (* anything) ")\n\n" + string-end))))) + (it "`full' should print full lines" + (with-local-buttercup + :suites test-suites :reporter #'backtrace-reporter + :frame-style 'full + (buttercup-run :noerror) + (expect (buttercup-output) :to-match + (rx-to-string + `(seq + string-start + (= 40 ?=) "\n" + "suite bc-bt-backtrace\n" + "\n" + "Traceback (most recent call last):\n" + " bc-bt-foo(\"" (eval ,long-string) "\")\n" + " bc-bt-bar(\"" (eval ,long-string) "\")\n" + " bc-bt-baz(\"" (eval ,long-string) "\")\n" + (* (seq " " (* not-newline) (= 3 (not (any ?.))) "\n")) + "error: (" (* anything) ")\n\n" + string-end))))) + (it "`pretty' should pretty-print frames" + (with-local-buttercup + :suites test-suites :reporter #'backtrace-reporter + :frame-style 'pretty + (buttercup-run :noerror) + (expect (buttercup-output) :to-match + (rx-to-string + `(seq + string-start + (= 40 ?=) "\n" + "suite bc-bt-backtrace\n" + "\n" + "Traceback (most recent call last):\n" + "λ (bc-bt-foo \"" (regex ,long-string) "\")\n" + "λ (bc-bt-bar \"" (regex ,long-string) "\")\n" + "λ (bc-bt-baz \"" (regex ,long-string) "\")\n" + (* (seq (or ?M ?λ) " (" (* not-newline) ; frame start + (*? (seq "\n " (* not-newline))) ; any number of pp lines + (* not-newline) ")\n")) ;; frame end + "error: (" (* anything) ")\n\n" + string-end))))) + (it "`omit' should print nothing" + (with-local-buttercup + :suites test-suites :reporter #'backtrace-reporter + :frame-style 'omit + (buttercup-run :noerror) + (expect (buttercup-output) :to-equal "")))) + (it "should signal an error for unknown styles" + (let ((buttercup-stack-frame-style 'not-a-valid-style)) + (expect (buttercup--format-stack-frame '(t myfun 1 2)) + :to-throw 'error '("Unknown stack trace style: not-a-valid-style")))) + (describe "should generate correct backtrace for" + (cl-macrolet + ((matcher-spec + (description &rest matcher) + `(it ,description + (with-local-buttercup + :reporter #'backtrace-reporter + (describe "backtrace for" + (it "matcher" + (expect (bc-bt-baz "text") ,@matcher))) + (buttercup-run :noerror) + (expect (buttercup-output) :to-equal + ,(mapconcat + #'identity + `(,(make-string 40 ?=) + "backtrace for matcher" + "" + "Traceback (most recent call last):" + " bc-bt-baz(\"text\")" + ,(concat + " (or (number-or-marker-p a) (signal " + (if (< emacs-major-version 27) + "(quote wrong-type-argument) (list (quot..." + "'wrong-type-argument (list 'number-or-m...")) + " signal(wrong-type-argument (number-or-marker-p \"text\"))" + "error: (wrong-type-argument number-or-marker-p \"text\")" + "" "") "\n")))))) + (matcher-spec "no matcher") + (matcher-spec ":to-be-truthy" :to-be-truthy) + (matcher-spec ":not :to-be-truthy" :not :to-be-truthy) + (matcher-spec ":to-be" :to-be 3) + (matcher-spec ":not :to-be" :not :to-be 3) + (matcher-spec ":to-equal" :to-equal 3) + (matcher-spec ":not :to-equal" :not :to-equal 3) + (matcher-spec ":to-have-same-items-as" :to-have-same-items-as '(3)) + (matcher-spec ":not :to-have-same-items-as" :not :to-have-same-items-as '(3)) + (matcher-spec ":to-match" :to-match ".") + (matcher-spec ":not :to-match" :not :to-match ".") + (matcher-spec ":to-be-in" :to-be-in '(2)) + (matcher-spec ":not :to-be-in" :not :to-be-in '(2)) + (matcher-spec ":to-contain" :to-contain 2) + (matcher-spec ":not :to-contain" :not :to-contain 2) + (matcher-spec ":to-be-less-than" :to-be-less-than 2) + (matcher-spec ":not :to-be-less-than" :not :to-be-less-than 2) + (matcher-spec ":to-be-greater-than" :to-be-greater-than 2) + (matcher-spec ":not :to-be-greater-than" :not :to-be-greater-than 2) + (matcher-spec ":to-be-weakly-less-than" :to-be-weakly-less-than 2) + (matcher-spec ":not :to-be-weakly-less-than" :not :to-be-weakly-less-than 2) + (matcher-spec ":to-be-weakly-greater-than" :to-be-weakly-greater-than 2) + (matcher-spec ":not :to-be-weakly-greater-than" :not :to-be-weakly-greater-than 2) + (matcher-spec ":to-be-close-to" :to-be-close-to 2 0.3) + (matcher-spec ":not :to-be-close-to" :not :to-be-close-to 2 0.2) + ;; (matcher-spec ":to-throw" :to-throw) + ;; (matcher-spec ":not :to-throw" :not :to-throw) + (matcher-spec ":to-have-been-called" :to-have-been-called) + (matcher-spec ":not :to-have-been-called" :not :to-have-been-called) + (matcher-spec ":to-have-been-called-with" :to-have-been-called-with 2) + (matcher-spec ":not :to-have-been-called-with" :not :to-have-been-called-with 2) + (matcher-spec ":to-have-been-called-times" :to-have-been-called-times 2) + (matcher-spec ":not :to-have-been-called-times" :not :to-have-been-called-times 2)))) + + +(describe "When using quiet specs in the batch reporter" + :var (print-buffer) + (before-each + (setq print-buffer (generate-new-buffer "*btrcp-reporter-test*")) + (spy-on 'send-string-to-terminal :and-call-fake + (apply-partially #'send-string-to-ansi-buffer print-buffer)) + ;; Convenience function + (spy-on 'buttercup-output :and-call-fake + (lambda () + "Return the text of `print-buffer'." + (with-current-buffer print-buffer + (buffer-string))))) + (after-each + (kill-buffer print-buffer) + (setq print-buffer nil)) + + (it "should print nothing if all specs are quiet" + (with-local-buttercup :color nil :quiet '(pending) :reporter #'buttercup-reporter-batch + (describe "top" + (it "spec 1") + (describe "second" + (it "spec 2") + (it "spec 3"))) + (describe "empty") + (buttercup-run)) + (expect (buttercup-output) :to-match + "^Running 0 out of 3 specs\\.\n\nRan 0 out of 3 specs, 0 failed, in [0-9.]+ms\\.$")) + + (it "should print the containing suites for non-quiet specs" + (with-local-buttercup :color nil :quiet '(pending) :reporter #'buttercup-reporter-batch + (describe "top" + (it "spec 1" (ignore)) + (describe "second" + (it "spec 2") + (it "spec 3" (ignore)) + (describe "third" + (it "spec 4")))) + (describe "empty") + (buttercup-run)) + (expect (buttercup-output) :to-match + (concat "^Running 2 out of 4 specs\\.\n\n" + "top\n" + " spec 1 ([0-9.]+ms)\n" + " second\n" + " spec 3 ([0-9.]+ms)\n\n" + "Ran 2 out of 4 specs, 0 failed, in [0-9.]+ms\\.$"))) + + (it "should quiet all of the given spec statuses" + ;; suppress stacktraces printed at buttercup-done + (spy-on 'buttercup-reporter-batch--print-failed-spec-report) + (with-local-buttercup + :color nil :quiet '(pending passed failed) :reporter #'buttercup-reporter-batch + (describe "passed" + (it "passed" (ignore))) + (describe "failed" + (it "failed" (buttercup-fail "because"))) + (describe "pending" + (it "pending")) + (buttercup-run t)) + (expect (buttercup-output) :to-match + "^Running 2 out of 3 specs\\.\n\nRan 2 out of 3 specs, 1 failed, in [0-9.]+ms\\.$")) + + (it "should handle `skipped' virtual status in quiet list" + ;; suppress stacktraces printed at buttercup-done + (spy-on 'buttercup-reporter-batch--print-failed-spec-report) + (with-local-buttercup + :color nil :quiet '(skipped) :reporter #'buttercup-reporter-batch + (describe "passed" + (it "passed" (ignore))) + (describe "failed" + (it "failed" (buttercup-fail "because"))) + (describe "pending" + (it "pending")) + (describe "skipped" + (it "skipped" (ignore))) + (buttercup-mark-skipped "skipped") + (buttercup-run t)) + (expect (buttercup-output) :to-match + (concat "^Running 2 out of 4 specs\\.\n\n" + "passed\n passed ([0-9.]+ms)\n\n" + "failed\n failed because ([0-9.]+ms)\n\n" + "pending\n pending PENDING ([0-9.]+ms)\n\n" + "Ran 2 out of 4 specs, 1 failed, in [0-9.]+ms\\.\n$"))) + + (it "should handle `disabled' virtual status in quiet list" + ;; suppress stacktraces printed at buttercup-done + (spy-on 'buttercup-reporter-batch--print-failed-spec-report) + (with-local-buttercup + :color nil :quiet '(disabled) :reporter #'buttercup-reporter-batch + (describe "passed" + (it "passed" (ignore))) + (describe "failed" + (it "failed" (buttercup-fail "because"))) + (describe "pending" + (it "pending")) + (describe "skipped" + (it "skipped" (ignore))) + (buttercup-mark-skipped "skipped") + (buttercup-run t)) + (expect (buttercup-output) :to-match + (concat "^Running 2 out of 4 specs\\.\n\n" + "passed\n passed ([0-9.]+ms)\n\n" + "failed\n failed because ([0-9.]+ms)\n\n" + "skipped\n skipped SKIPPED ([0-9.]+ms)\n\n" + "Ran 2 out of 4 specs, 1 failed, in [0-9.]+ms\\.\n$")))) + +;;;;;;;;;;;;;;;;;;;;; +;;; buttercup-run + (describe "The `buttercup-run' function" - :var (parent-suite child-suite spec reporter) + :var (parent-suite child-suite spec) (before-each - (ignore reporter) - (setf (symbol-function 'reporter) (lambda (event arg) (ignore event arg))) (setq parent-suite (make-buttercup-suite :description "parent-suite") child-suite (make-buttercup-suite :description "child-suite") spec (make-buttercup-spec :description "spec")) (buttercup-suite-add-child parent-suite child-suite) (buttercup-suite-add-child child-suite spec) - (spy-on 'reporter)) + (spy-on 'reporter) + (spy-on 'buttercup--run-suite)) + (it "should signal an error if no suites are defined" + (with-local-buttercup + (expect (buttercup-run) :to-throw 'error '("No suites defined")))) + (it "should return :no-suites for no suites and noerror" + (with-local-buttercup + (expect (buttercup-run t) :to-equal :no-suites))) (it "should raise an error if at least one spec failed" (setf (buttercup-spec-status spec) 'failed) - (cl-letf (((symbol-function 'buttercup--run-suite) #'ignore) - (buttercup-reporter 'reporter)) - (let ((buttercup-suites (list parent-suite))) - (expect (buttercup-run) :to-throw)))) + (with-local-buttercup :suites (list parent-suite) + (expect (buttercup-run) :to-throw 'error '("")))) + (it "should return nil for failing specs and noerror" + (setf (buttercup-spec-status spec) 'failed) + (with-local-buttercup :suites (list parent-suite) + (expect (buttercup-run t) :not :to-be-truthy))) + (it "should return t for passing specs" + (with-local-buttercup :suites (list parent-suite) + (expect (buttercup-run) :to-be-truthy) + (expect (buttercup-run t) :to-be-truthy))) (it "should call the reporter twice with events buttercup-started and -done" - (cl-letf (((symbol-function 'buttercup--run-suite) #'ignore) - (buttercup-reporter 'reporter)) - (let ((buttercup-suites (list parent-suite))) - (expect (buttercup-run) :not :to-throw) - (expect 'reporter :to-have-been-called-times 2) - (expect 'reporter :to-have-been-called-with 'buttercup-started buttercup-suites) - (expect 'reporter :to-have-been-called-with 'buttercup-done buttercup-suites))) - ) + (with-local-buttercup :suites (list parent-suite) :reporter 'reporter + (expect (buttercup-run) :not :to-throw) + (expect 'reporter :to-have-been-called-times 2) + (expect 'reporter :to-have-been-called-with 'buttercup-started buttercup-suites) + (expect 'reporter :to-have-been-called-with 'buttercup-done buttercup-suites))) (it "should call `buttercup--run-suite' once per suite" - (let ((buttercup-suites (list parent-suite)) runner) - (ignore runner) - (setf (symbol-function 'runner) (lambda (suite) (ignore suite))) - (spy-on 'runner) - (cl-letf (((symbol-function 'buttercup--run-suite) #'runner) - (buttercup-reporter 'reporter) - (buttercup-suites (make-list 5 parent-suite))) - (expect (buttercup-run) :not :to-throw) - (expect 'runner :to-have-been-called-times 5))))) + (with-local-buttercup :reporter 'reporter :suites (make-list 5 parent-suite) + (expect (buttercup-run) :not :to-throw) + (expect 'buttercup--run-suite :to-have-been-called-times 5)))) (describe "The `buttercup--print' function" (before-each @@ -1362,7 +1746,7 @@ text properties using `ansi-color-apply'." :to-have-been-called-with "Hello, world"))) -(describe "The `buttercup--mark-skipped' function" +(describe "The `buttercup-mark-skipped' function" :var (suites) (before-each (with-local-buttercup @@ -1381,44 +1765,185 @@ text properties using `ansi-color-apply'." (it "2-3 spec" (ignore)) (it "2-4 spec" (ignore))) (setq suites buttercup-suites))) - (it "should do nothing with a match-all pattern" + (it "should do nothing with a reversed match-all pattern" (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 5) - (buttercup--mark-skipped suites '(".")) + (with-local-buttercup :suites suites + (buttercup-mark-skipped "." t)) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 5) - (with-local-buttercup - (setq buttercup-suites suites) + (with-local-buttercup :suites suites (buttercup-run)) (expect (buttercup-suites-total-specs-pending suites) :to-equal 5) (expect (cl-count "SKIPPED" (buttercup--specs suites) :key #'buttercup-spec-failure-description) :to-equal 0)) - (it "should mark all specs as pending with no pattern" - (buttercup--mark-skipped suites '()) + (it "should mark all specs as pending with a reversed match none pattern" + (with-local-buttercup :suites suites + (buttercup-mark-skipped "[z-a]" t)) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 11)) (it "should handle multiple patterns" - (buttercup--mark-skipped suites '("1-1-[1-2]" "[12]-4")) + (with-local-buttercup :suites suites + (buttercup-mark-skipped '("1-1-1" "1-1-2" "1-4" "2-4") t)) + (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) + (expect (buttercup-suites-total-specs-pending suites) :to-equal 8)) + (it "should support predicates" + (with-local-buttercup :suites suites + (buttercup-mark-skipped + (lambda (spec) (= 2 (cl-count ?- (buttercup-spec-full-name spec)))))) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) - (expect (buttercup-suites-total-specs-pending suites) :to-equal 8))) + (expect (buttercup-suites-total-specs-pending suites) :to-equal 10)) + (it "should support reversed predicates" + (with-local-buttercup :suites suites + (buttercup-mark-skipped + (lambda (spec) (= 2 (cl-count ?- (buttercup-spec-full-name spec)))) + t)) + (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) + (expect (buttercup-suites-total-specs-pending suites) :to-equal 6)) + (it "should signal an error for invalid matchers" + (with-local-buttercup + (expect (buttercup-mark-skipped 4) :to-throw)) + (with-local-buttercup + (expect (buttercup-mark-skipped (list "re" "re" 5 "re")) :to-throw))) + ) ;;;;;;;;;;;;;;;;;;;;; ;;; ERT Compatibility (describe "Buttercup's ERT compatibility wrapper" - (it "should convert `ert-test-failed' into `buttercup-failed" + (it "should convert `ert-test-failed' into `buttercup-failed'" (expect (buttercup-with-converted-ert-signals (should (equal 1 2))) :to-throw 'buttercup-failed)) - (it "should convert `ert-test-skipped' into `buttercup-pending" + (it "should convert `ert-test-skipped' into `buttercup-pending'" (assume (functionp 'ert-skip) "Loaded ERT version does not provide `ert-skip'") (expect (buttercup-with-converted-ert-signals (ert-skip "Skipped this test")) :to-throw 'buttercup-pending))) +;;;;;;;;;;;;;;;;;; +;;; test discovery + +(describe "`buttercup-run-discover' should" + (describe "parse command line arguments" + (before-each + (spy-on 'buttercup-run) + (spy-on 'buttercup-mark-skipped) + (spy-on 'directory-files-recursively) + (spy-on 'buttercup-error-on-stale-elc)) + (it "ignoring `--'" + (let ((command-line-args-left '("--"))) + (buttercup-run-discover) + (expect command-line-args-left :to-equal nil))) + (it "requiring an extra argument for `--traceback'" + (let ((command-line-args-left '("--traceback"))) + (expect (buttercup-run-discover) :to-throw 'error '("Option requires argument: --traceback")))) + (it "checking `--traceback' argument for validity" + (let ((command-line-args-left '("--traceback" "unknown"))) + (with-local-buttercup + (expect (buttercup-run-discover) :to-throw 'error '("Unknown stack trace style: unknown"))))) + (it "setting `buttercup-stack-frame-style' from `--traceback' arg" + (let ((command-line-args-left '("--traceback" "full"))) + (with-local-buttercup + (buttercup-run-discover) + (expect buttercup-stack-frame-style :to-equal 'full)) + (expect command-line-args-left :to-equal nil))) + (it "requiring an extra argument for `--pattern' or `-p'" + (let ((command-line-args-left '("--pattern"))) + (expect (buttercup-run-discover) :to-throw 'error '("Option requires argument: --pattern")) + (setq command-line-args-left '("-p")) + (expect (buttercup-run-discover) :to-throw 'error '("Option requires argument: -p")))) + (it "collecting `--pattern' and `-p' args and send to `buttercup-mark-skipped'" + (let ((command-line-args-left '("--pattern" "foo" "-p" "bar" "--pattern" "baz")) + buttercup-mark-skipped-args) + (buttercup-run-discover) + (expect command-line-args-left :to-equal nil) + (expect 'buttercup-mark-skipped :to-have-been-called-times 1) + (setq buttercup-mark-skipped-args (car (spy-calls-args-for 'buttercup-mark-skipped 0))) + (expect buttercup-mark-skipped-args :to-have-same-items-as '("foo" "bar" "baz")))) + (it "clearing `buttercup-color' if `--no-color' is given" + (let ((command-line-args-left '("--no-color")) + (buttercup-color t)) + (buttercup-run-discover) + (expect buttercup-color :to-equal nil) + (expect command-line-args-left :to-equal nil) + (setq command-line-args-left '("-c") + buttercup-color t) + (buttercup-run-discover) + (expect buttercup-color :to-equal nil) + (expect command-line-args-left :to-equal nil))) + (it "adding `skipped' and `disabled' to quiet statuses if `--no-skip' is given" + (let ((command-line-args-left '("--no-skip"))) + (with-local-buttercup + (buttercup-run-discover) + (expect buttercup-reporter-batch-quiet-statuses :to-contain 'skipped) + (expect buttercup-reporter-batch-quiet-statuses :to-contain 'disabled)) + (expect command-line-args-left :to-equal nil))) + (it "adding `pending' and `passed' to quiet statuses if `--only-error' is given" + (let ((command-line-args-left '("--only-error"))) + (with-local-buttercup + (buttercup-run-discover) + (expect buttercup-reporter-batch-quiet-statuses :to-contain 'pending) + (expect buttercup-reporter-batch-quiet-statuses :to-contain 'passed)) + (expect command-line-args-left :to-equal nil))) + (it "calling `buttercup-error-on-stale-elc' if `--stale-file-error' is given" + (let ((command-line-args-left '("--stale-file-error"))) + (with-local-buttercup + (buttercup-run-discover) + (expect 'buttercup-error-on-stale-elc :to-have-been-called-times 1) + (expect command-line-args-left :to-equal nil)))) + (it "search any unknown args for test files" + (let ((command-line-args-left '("foo" "--traceback" "full" "bar" "--strange" "baz"))) + (with-local-buttercup + (buttercup-run-discover) + (expect 'directory-files-recursively :to-have-been-called-times 4) + (expect 'directory-files-recursively :to-have-been-called-with "foo" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'") + (expect 'directory-files-recursively :to-have-been-called-with "bar" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'") + (expect 'directory-files-recursively :to-have-been-called-with "--strange" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'") + (expect 'directory-files-recursively :to-have-been-called-with "baz" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'")) + (expect command-line-args-left :to-equal nil))) + ) + (describe "find and load files" + (before-each + (spy-on 'buttercup-run) + (spy-on 'buttercup-mark-skipped) + (spy-on 'load) + (spy-on 'relative-load-path :and-call-fake + (lambda (args) + "Return `car' of args relative to `default-directory'." + (replace-regexp-in-string + (format "^\\(\\./\\|%s\\)" (regexp-quote default-directory)) + "" + (car args)))) + ) + (it "named test-*.el and *-tests?.el but no other files" + (buttercup--test-with-tempdir + '("test.el" "tests.el" "test-actually.el" + "foo/test-foo.el" "foo/bar/bar-test.el" + "baz/no-test-here.el" "baz/baz-tests.el") + (buttercup-run-discover) + (expect 'load :to-have-been-called-times 4) + (let ((loaded-files (mapcar #'relative-load-path + (spy-calls-all-args 'load)))) + (expect loaded-files :to-have-same-items-as '("test-actually.el" + "foo/test-foo.el" + "foo/bar/bar-test.el" + "baz/baz-tests.el"))))) + (it "only in given directories" + (buttercup--test-with-tempdir + '("root-tests.el" + "a/a-tests.el" "a/b/ab-tests.el" + "b/b-tests-el" "b/a/ba-tests.el") + (let ((command-line-args-left '("a"))) + (buttercup-run-discover)) + (expect 'load :to-have-been-called-times 2) + (let ((loaded-files (mapcar #'relative-load-path (spy-calls-all-args 'load)))) + (expect loaded-files :to-have-same-items-as '("a/a-tests.el" + "a/b/ab-tests.el"))))))) + ;;;;;;;;;;;;; ;;; Utilities @@ -1482,6 +2007,55 @@ text properties using `ansi-color-apply'." (expect (length (cdr specs)) :to-equal 1) (expect (cl-caadr specs) :to-equal "should fontify special keywords"))))) +;;;;;;;;;;;;;;;;;;; +;;; Stale elc files + +(describe "For stale `elc' file checks" + (describe "`buttercup-check-for-stale-elc'" + :var (el-time elc-time) + (before-each + (spy-on 'file-attributes :and-call-fake + (lambda (filename &optional _id-format) + (make-list + 10 + (make-list 4 + (pcase (file-name-extension filename) + ("elc" elc-time) + ("el" el-time))))))) + (it "should do nothing for `el' files" + (setq el-time 2 ;; elc is older than el + elc-time 1) + (expect (buttercup-check-for-stale-elc "buttercup.el") :not :to-throw)) + (it "should signal error when `elc' is older than `el'" + (setq el-time 2 ;; elc is older than el + elc-time 1) + (expect (buttercup-check-for-stale-elc "buttercup.elc") :to-throw)) + (it "should not signal error when `elc' is newer than `el'" + (setq el-time 2 ;; elc is older than el + elc-time 3) + (expect (buttercup-check-for-stale-elc "buttercup.elc") :not :to-throw)) + (it "should do nothing if the `el' file does not exist" + (setq el-time 3 ;; el is older than elc + elc-time 2) + (spy-on 'file-exists-p) + (expect (buttercup-check-for-stale-elc "buttercup.elc") :not :to-throw))) + + (describe "`buttercup-error-on-stale-elc'" + (it "should activate with no argument" + (let (after-load-functions) + (buttercup-error-on-stale-elc) + (expect after-load-functions :to-contain 'buttercup-check-for-stale-elc))) + (it "should deactivate with almost any argument" + (let ((after-load-functions '(buttercup-check-for-stale-elc))) + (buttercup-error-on-stale-elc 2) + (expect after-load-functions :not :to-contain 'buttercup-check-for-stale-elc))) + (it "should toggle when given `toggle' as argument" + (let (after-load-functions) + (buttercup-error-on-stale-elc 'toggle) + (expect after-load-functions :to-contain 'buttercup-check-for-stale-elc) + (buttercup-error-on-stale-elc 'toggle) + (expect after-load-functions :not :to-contain 'buttercup-check-for-stale-elc))))) + ;; Local Variables: ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil |