Permalink
Browse files

Add assert-empty and various refutations

  • Loading branch information...
1 parent 7c1a0f5 commit feeb9fa4438c16717bb0227b9c0a3194898884c3 @ferrous26 committed Feb 9, 2013
Showing with 91 additions and 49 deletions.
  1. +91 −49 minitest.scm
View
@@ -1,55 +1,97 @@
-(define colour 31)
-(define next-colour (lambda ()
- (begin
- (if (equal? colour 36)
- (set! colour 31)
- (set! colour (+ 1 colour)))
- colour)))
+;; Some impure FP to get started
+
+(define colour 31) ; internal
+(define next-colour
+ (lambda ()
+ (begin
+ (if (equal? colour 36)
+ (set! colour 31)
+ (set! colour (+ 1 colour)))
+ colour)))
(define test-count 0)
(define fails '())
-(define pass-token (lambda () (string-append "\e[" (number->string (next-colour)) "m*\e[0m")))
+(define pass-token
+ (lambda () (string-append "\e[" (number->string (next-colour)) "m*\e[0m")))
(define fail-token "\e[41m\e[37mF\e[0m")
-(define assert (lambda (expr name msg)
- (begin
- (set! test-count (+ 1 test-count))
- (if (expr)
- (display (pass-token))
- (begin
- (display fail-token)
- (set! fails (append fails (list (cons test-count (cons name msg))))))))))
-
-(define assert-equal (lambda (expected actual name)
- (assert (lambda () (equal? expected actual))
- name
- (list "Expected" actual "to be equal to" expected))))
-
-(define display-test-results (lambda ()
- (begin
- (newline)
-
- (if (= test-count 1)
- (display `(,test-count test))
- (display `(,test-count tests)))
-
- (if (= (length fails) 1)
- (display `(,(length fails) failure))
- (display `(,(length fails) failures)))
-
- (newline)
- (newline)
-
- (for-each
- (lambda (fail)
- (begin
- (newline)
- (display (string-append (number->string (car fail)) ") "))
- (display (cadr fail))
- (newline)
- (display (cddr fail))
- (newline)))
- fails)
-
- (newline))))
+
+
+;; ASSERTIONS
+
+(define assert
+ (lambda (expr name msg)
+ (begin
+ (set! test-count (+ 1 test-count))
+ (if (expr)
+ (display (pass-token))
+ (begin
+ (display fail-token)
+ (set! fails (append fails (list (cons test-count (cons name msg))))))))))
+
+(define refute (lambda (expr name msg) (assert (not (expr)) name msg)))
+
+
+(define assert-equal
+ (lambda (expected actual name)
+ (assert (lambda () (equal? expected actual))
+ name
+ (list "Expected" actual "to be equal to" expected))))
+
+(define refute-equal
+ (lambda (expected actual name)
+ (assert (lambda () (not (equal? expected actual)))
+ name
+ (list "Expected" actual "to NOT be equal to" expected))))
+
+
+(define assert-empty
+ (lambda (collection name)
+ (lambda ()
+ (cond
+ ((string? collection) (= 0 (string-length collection)))
+ (else (null? collection))))
+ name
+ (list "Expected" collection "to be empty")))
+
+(define refute-empty
+ (lambda (collection name)
+ (lambda ()
+ (not (cond
+ ((string? collection) (= 0 (string-length collection)))
+ (else (null? collection)))))
+ name
+ (list "Expected" collection "to NOT be empty")))
+
+
+;; Default display mechanism
+
+(define display-test-results
+ (lambda ()
+ (begin
+ (newline)
+
+ (if (= test-count 1)
+ (display `(,test-count test))
+ (display `(,test-count tests)))
+
+ (if (= (length fails) 1)
+ (display `(,(length fails) failure))
+ (display `(,(length fails) failures)))
+
+ (newline)
+ (newline)
+
+ (for-each
+ (lambda (fail)
+ (begin
+ (newline)
+ (display (string-append (number->string (car fail)) ") "))
+ (display (cadr fail))
+ (newline)
+ (display (cddr fail))
+ (newline)))
+ fails)
+
+ (newline))))

0 comments on commit feeb9fa

Please sign in to comment.