[Geiser-users] [PATCH] Add test functionality for Racket and rackunit

[Diogo F. S. Ramos]

Using the command `geiser-racket-test' it's possible to run the tests
listed in a `test' submodule defined inside the current buffer.

A new buffer, using the Compilation Mode, will be open and it's
possible to navigate through the errors using the usual keys.

As `raco test ...' always returns 0, a wrapper racket program is used
to check if there was any output to stderr. Any output to stderr is
interpret as a failure in some check and the wrapper racket program
returns 1, after letting all the checks run.

A `rackunit' symbol is installed to the compilation alists so
Compilation Mode can interpret the output from the rackunit library.
---
It's now asynchronous and it signals to the user if some check fails.

Now I want to personalize the Compilation Mode buffer so it looks like
a geiser buffer.

 elisp/geiser-racket.el        |   35 +++++++++++++++++++++++++++++++++++
 scheme/racket/geiser/test.rkt |   17 +++++++++++++++++
 2 files changed, 52 insertions(+)
 create mode 100644 scheme/racket/geiser/test.rkt

diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index d9d59d1..491cff5 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -216,6 +216,41 @@ using start-geiser, a procedure in the geiser/server 
module."
   t)
 
 
+;;; Test module
+(defun geiser-racket--test-install ()
+  "Install a `rackunit' symbol to compilation alists"
+  (let ((symb 'rackunit))
+    (add-to-list 'compilation-error-regexp-alist
+                 symb
+                 t)
+    (add-to-list 'compilation-error-regexp-alist-alist
+                 (list symb
+                       (concat "^location: *(#<path:\\(.*\\)> "
+                               "\\([0-9]*\\) \\([0-9]*\\) "
+                               "\\([0-9]*\\) \\([0-9]*\\))$")
+                       1 2 3)
+                 t (lambda (e el)
+                     (eq (car e) (car el))))
+      t))
+
+(geiser-racket--test-install)
+
+(defun geiser-racket--test-module (filename)
+  "Test a file module with a `test' submodule"
+  (compilation-start
+   (mapconcat
+    #'identity
+    (list (geiser-racket--binary)
+          (expand-file-name "racket/geiser/test.rkt" geiser-scheme-dir)
+          (shell-quote-argument filename))
+    " ")))
+
+(defun geiser-racket-test ()
+  "Runs tests defined inside a `test' submodule in the current buffer"
+  (interactive)
+  (geiser-racket--test-module (buffer-file-name)))
+
+
 ;;; Error display
 
 (defconst geiser-racket--file-rxs
diff --git a/scheme/racket/geiser/test.rkt b/scheme/racket/geiser/test.rkt
new file mode 100644
index 0000000..6dc5d6c
--- /dev/null
+++ b/scheme/racket/geiser/test.rkt
@@ -0,0 +1,17 @@
+#lang racket/base
+
+(require racket/cmdline
+         racket/port)
+
+(module+ main
+  (define filename (command-line #:args (filename) filename))
+  (define status 0)
+  (let-values (((subproc stdout stdin stderr)
+                (subprocess #f #f #f
+                            (find-executable-path "raco")
+                            "test" filename)))
+    (unless (eof-object? (peek-byte stderr))
+      (copy-port stderr (current-error-port))
+      (set! status 1))
+    (subprocess-wait subproc)
+    (exit status)))
-- 
1.7.9.5