Compare commits

..

3 Commits

3 changed files with 140 additions and 0 deletions

View File

@@ -43,6 +43,35 @@ application on the open internet; I just hacked it together for
testing on localhost during development and it's probably hilariously testing on localhost during development and it's probably hilariously
insecure. insecure.
## End-to-End Tests
There's a (fairly minimal at the moment) end-to-end test suite defined
in [tests.scm](./tests.scm). To run it you'll need:
- [Guile](https://www.gnu.org/software/guile/) again (no substitute
this time, sorry)
- [guile-json](https://github.com/aconchillo/guile-json)
- Firefox
I'm also pretty sure it won't work on a non-POSIX system, though I
haven't tried it.
Given that's all sorted, you should be able to run:
```
guile tests.scm
```
It will print a JUint XML report to standard out, you can pretty-print
it with:
```
guile tests.scm | xmllint --format -
```
Though, of course, this will require that you have `xmllint` on your
system.
## Peripherals ## Peripherals
### Terminal ### Terminal

64
e2e/testing.scm Normal file
View File

@@ -0,0 +1,64 @@
(define-module (e2e testing)
#:export (assert define-test run-tests))
(use-modules
(sxml simple)
(srfi srfi-1))
(define *tests* (make-fluid '()))
(define (assert condition . args)
(unless condition
(let ((msg (if (null? args) "Assertion failed" (car args))))
(raise-exception `(assertion-failed . ,msg)))))
(define-syntax-rule (define-test name body ...)
(fluid-set!
*tests*
(append (fluid-ref *tests*)
(list (cons 'name (lambda () body ...))))))
(define (fail-handler ex)
(if (and (pair? ex) (eq? 'assertion-failed (car ex)))
(cons 'fail (cdr ex))
(cons 'error (format #f "~a" ex))))
(define (run-test test)
(cons (car test)
(with-exception-handler fail-handler
(lambda ()
((cdr test))
'pass)
#:unwind? #t)))
(define (fail? result)
(and (pair? (cdr result))
(eq? 'fail (cadr result))))
(define (error? result)
(and (pair? (cdr result))
(eq? 'error (cadr result))))
(define (test-junit-report result)
`(testcase
(@ (name ,(symbol->string (car result))))
,@(cond
((fail? result) `((failure (@ (message ,(cddr result))))))
((error? result) `((error (@ (message ,(cddr result))))))
(#t '()))))
(define (junit-report results)
(let ((count (length results))
(fails (length (filter fail? results)))
(errors (length (filter error? results))))
`(testsuites
(testsuite
(@ (name "wipforth e2e")
(tests ,count)
(failures ,fails)
(errors ,errors))
,@(map test-junit-report results)))))
(define (run-tests)
(let ((results (map run-test (fluid-ref *tests*))))
(sxml->xml (junit-report results))))

47
tests.scm Normal file
View File

@@ -0,0 +1,47 @@
(add-to-load-path (dirname (current-filename)))
(use-modules
(e2e marionette)
(e2e testing)
(ice-9 regex)
((server) #:prefix server-)
(srfi srfi-1))
(define (lines s)
(string-split s #\newline))
(define (get-result-line client)
(let ((display (get-display client)))
(last (lines (string-trim-right display)))))
(define server (server-start))
(define firefox (start-firefox))
(define client (client-setup))
(navigate client "http://localhost:8080")
(sleep 5)
(define-test preload-loads-successfully
(let* ((display (get-display client))
(first-line (first (lines display))))
(assert (string-match "Loading prelude \\.+ done" first-line)
(format #f "Prelude load line: ~s" first-line))))
(define-test six-seven-times-dot-cr-yields-42
(input-line client "6 7 * . CR")
(let* ((result-line (get-result-line client)))
(assert (string=? "42" result-line)
(format #f "Result line: ~s" result-line))))
(define-test define-hello-then-run-hello-prints-message
(input-line client ": HELLO .\" Hello, world!\" CR ;")
(input-line client "HELLO")
(let* ((result-line (get-result-line client)))
(assert (string=? "Hello, world!" result-line)
(format #f "Result line: ~s" result-line))))
(run-tests)
(client-teardown client)
(close-firefox firefox)
(server-stop server)