Compare commits
3 Commits
e13452db15
...
fb52e5a701
| Author | SHA1 | Date | |
|---|---|---|---|
| fb52e5a701 | |||
| a1b003a1cd | |||
| 9576769e09 |
29
README.md
29
README.md
@@ -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
|
||||
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
|
||||
|
||||
### Terminal
|
||||
|
||||
64
e2e/testing.scm
Normal file
64
e2e/testing.scm
Normal 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
47
tests.scm
Normal 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)
|
||||
Reference in New Issue
Block a user