euler/test-utils.scm at main · KNPhilip/euler · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
(define test-name "")
(define test-results '())

(define (initialize-test name)
  (set! test-name name)
  (set! test-results '()))

(define (assert-equal expected actual)
  (let ((result (equal? expected actual)))
    (set! test-results (cons result test-results))
    (if result
        #t
        (begin
          (display "\nAssertion failed in \"")
          (display test-name) (display "\":\n")

          (display "  Expected: ") (write expected) (newline)
          (display "  Got: ") (write actual) (newline)))
    result))

(define (assert-true actual)
  (let ((result (equal? #t actual)))
    (set! test-results (cons result test-results))
    (if result
        #t
        (begin
          (display "\nAssertion failed in \"")
          (display test-name) (display "\":\n")

          (display "  Expected #t but got: ") (write actual)))
    result))

(define (assert-false actual)
  (let ((result (equal? #f actual)))
    (set! test-results (cons result test-results))
    (if result
        #t
        (begin
          (display "\nAssertion failed in \"")
          (display test-name) (display "\":\n")

          (display "  Expected #f but got: ") (write actual)))
    result))

(define (count pred lst)
  (if (null? lst)
      0
      (+ (if (pred (car lst)) 1 0)
         (count pred (cdr lst))
      )))

(define (end-test)
  (let* ((total (length test-results))
         (passed (count (lambda (x) x) test-results))
         (failed (- total passed)))
    (newline)
    (display "Finished running \"") (display test-name) (display "\": \n")
    (display "  Total tests: ") (write total) (newline)
    (display "  Passed: ") (write passed) (newline)
    (display "  Failed: ") (write failed) (newline)
    (newline)
    (exit)))