11 Enigma API: Test Subcommand🔗

Returns the values that indicate: exact-integer? total test success and a list of objects that describe properties of tested files.

The source code of this module:

#lang racket/base

(require racket/contract/base)

(require racket/match)

(require threading)

(require "../compiler/stamp/stamp.rkt")

(require "../emacs/file/content-guess.rkt")

(require "../emacs/file/context.rkt")

(require "../emacs/path/load-path.rkt")

(require "../emacs/system/run-emacs.rkt")

(require "../system/utils/path.rkt")

(provide

(contract-out

[test-found-emacs-lisp-files

(-> path-string? (listof string?)

(values exact-integer? (listof hash?)))]))

(define (test-emacs-lisp-file file-path load-path extra-emacs-flags)

(define test-runner (guess-file-test-runner file-path))

(eprintf " Testing: ~a\n" file-path)

(define exit-code

(match test-runner

['ert

(define cmdline-args

(append (make-emacs-cmdline-args load-path extra-emacs-flags)

`("-batch"

,(~> file-path path->directory path->string)

"-l" ,(path->string file-path)

"-f" "ert-run-tests-batch-and-exit")))

(run-emacs cmdline-args)]

['ert-runner

(define cmdline-args

(append (make-emacs-cmdline-args load-path extra-emacs-flags)

(~> file-path path->string list)))

(run-ert-runner cmdline-args)]

['buttercup

(define cmdline-args

(append (make-emacs-cmdline-args load-path extra-emacs-flags)

(~> file-path path->directory path->string list)))

(run-buttercup cmdline-args)]

[_ (raise (exn:fail (format "Unknown test runner, given: ~v" test-runner)

(current-continuation-marks)))]))

(match exit-code

[0 (create-stamp file-path "tested")]

[_ (void)])

exit-code)

(define (emacs-lisp-test-file? file-path)

(define name (path->name file-path))

(and (not (regexp-match #rx"^test(s|)-helper\\.el$" name))

(or (regexp-match #rx"^test(s|)-.*\\.el$" name)

(regexp-match #rx".*-test(s|)\\.el$" name))))

(define (test-found-emacs-lisp-files start-path extra-emacs-flags)

(define result-code (make-parameter 0))

(define-values (emacs-lisp-files load-path)

(find-emacs-lisp-context start-path))

(define result-hash

(for/list ([emacs-lisp-file emacs-lisp-files]

#:when (emacs-lisp-test-file? emacs-lisp-file))

(define exit-code

(test-emacs-lisp-file emacs-lisp-file load-path extra-emacs-flags))

(define successful? (= 0 exit-code))

(define h

(hash 'exit-code exit-code

'file-path (path->string emacs-lisp-file)

'successful? successful?))

(when (not successful?)

(result-code exit-code))

h))

(values (result-code) result-hash))