Skip to content

Commit

Permalink
Add (assert-list=).
Browse files Browse the repository at this point in the history
  • Loading branch information
@codecop
codecop committed Apr 18, 2021
1 parent 88918d0 commit 38fad46
Show file tree
Hide file tree
Showing 3 changed files with 149 additions and 75 deletions.
50 changes: 37 additions & 13 deletions assert-r5rs.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -88,15 +88,43 @@

(define (-make-message-numbered i expected actual)
(define (item i)
(string-append (number->string i) ". item "))
(-make-message (item i) expected actual))
(string-append (number->string i)
". item "))
(-make-message (item i)
expected
actual))

(define (-check-numbered= i to-string eq-op expected actual)
(check (-make-message-numbered i
(to-string expected)
(to-string actual))
(eq-op expected actual)))

(define (assert-list= to-string eq-op expected-list actual-list)
(define (check-list-element i expected actual)
(let* ((expected-l (length expected))
(actual-l (length actual))
(no-more? (< expected-l actual-l))
(has-more? (> expected-l actual-l))
(both-null? (and (null? expected) (null? actual))))
(cond (both-null? -success-marker)
(no-more? (fail (-make-message-numbered (+ i expected-l)
"no more elements"
"more elements")))
(has-more? (fail (-make-message-numbered (+ i actual-l)
"more elements"
"no more elements")))
(else (check-element i expected actual)))))
(define (check-element i expected actual)
(let* ((expected-element (car expected))
(actual-element (car actual)))
(append (-check-numbered= i to-string eq-op expected-element actual-element)
(check-list-element (+ i 1)
(cdr expected)
(cdr actual)))))
(lambda ()
(check-list-element 1 expected-list actual-list)))

(define (assert-list-deep= to-string eq-op expected-list actual-list)
(define (check-list-element i expected actual)
(let* ((expected-l (length expected))
Expand All @@ -106,11 +134,11 @@
(both-null? (and (null? expected) (null? actual))))
(cond (both-null? -success-marker)
(no-more? (fail (-make-message-numbered (+ i expected-l)
"no more elements"
"more elements")))
"no more elements"
"more elements")))
(has-more? (fail (-make-message-numbered (+ i actual-l)
"more elements"
"no more elements")))
"more elements"
"no more elements")))
(else (check-element i expected actual)))))
(define (check-element i expected actual)
(let* ((expected-element (car expected))
Expand All @@ -119,18 +147,14 @@
(no-sublist? (pair? actual-element))
(both-pair? (and sublist? no-sublist?)))
(cond (both-pair? (append ; dummy chaining
(check-list-element (+ (* i 10) 1)
(check-list-element (+ 1 (* i 10))
expected-element
actual-element)
(check-list-element (+ i 1)
(cdr expected)
(cdr actual))))
(sublist? (fail (-make-message-numbered i
"a sublist"
"no sublist")))
(no-sublist? (fail (-make-message-numbered i
"no sublist"
"a sublist")))
(sublist? (fail (-make-message-numbered i "a sublist" "no sublist")))
(no-sublist? (fail (-make-message-numbered i "no sublist" "a sublist")))
(else (append ; dummy chaining
(-check-numbered= i to-string eq-op expected-element actual-element)
(check-list-element (+ i 1)
Expand Down
89 changes: 57 additions & 32 deletions test/assert-chicken-test.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,58 +40,85 @@
"in range expected:<[0.99-1.01]> but was:<1.1>"
(assert-inexact= 1. 1.1 0.01))

(test-case "(assert-list-deep=)"
(assert-list-deep= number->string
(test-case "(assert-list=)"
(assert-list= number->string
=
(list 1 2)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on wrong element"
(test-failure "(assert-list=) fails on wrong element"
"2. item expected:<3> but was:<2>"
(assert-list-deep= number->string
(assert-list= number->string
=
(list 1 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on short list"
(test-failure "(assert-list=) fails on short list"
"3. item expected:<more elements> but was:<no more elements>"
(assert-list-deep= number->string
(assert-list= number->string
=
(list 1 2 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on long list"
(test-failure "(assert-list=) fails on long list"
"2. item expected:<no more elements> but was:<more elements>"
(assert-list-deep= number->string
(assert-list= number->string
=
(list 1)
(list 1 2)))

(test-case "(assert-list-deep=)"
(assert-list-deep= number->string
=
(list 1 2)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on wrong element"
"2. item expected:<3> but was:<2>"
(assert-list-deep= number->string
=
(list 1 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on short list"
"3. item expected:<more elements> but was:<no more elements>"
(assert-list-deep= number->string
=
(list 1 2 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on long list"
"2. item expected:<no more elements> but was:<more elements>"
(assert-list-deep= number->string
=
(list 1)
(list 1 2)))

(test-case "(assert-list-deep=) recursive"
(assert-list-deep= number->string
=
(list 1 (list 2 3))
(list 1 (list 2 3))))
=
(list 1 (list 2 3))
(list 1 (list 2 3))))

(test-failure "(assert-list-deep=) recursive fails on wrong element type"
"2. item expected:<a sublist> but was:<no sublist>"
(assert-list-deep= number->string
=
(list 1 (list 3))
(list 1 2)))
=
(list 1 (list 3))
(list 1 2)))

(test-failure "(assert-list-deep=) recursive fails on wrong element"
"22. item expected:<3> but was:<4>"
(assert-list-deep= number->string
=
(list 1 (list 2 3))
(list 1 (list 2 4))))
=
(list 1 (list 2 3))
(list 1 (list 2 4))))

(test-case "(assert-list-deep=) with strings"
(assert-list-deep= values
string=?
(list "a")
(list "a"))
string=?
(list "a")
(list "a"))
(assert-string-list= (list "a")
(list "a")))

Expand Down Expand Up @@ -125,7 +152,7 @@

(test-case "(assert-raise) on abort symbol"
(assert-raise "a" (lambda ()
(abort 'a))))
(abort 'a))))

(test-case "(assert-raise) on abort string"
(assert-raise "a" (lambda ()
Expand All @@ -137,38 +164,36 @@

(test-case "(assert-raise) on error string"
(assert-raise "a" (lambda ()
(error "a"))))
(error "a"))))

(test-failure "(assert-raise) fails"
"raise expected:<a> but was:<b>"
(assert-raise 'a (lambda ()
(abort 'b))))
(abort 'b))))

(test-failure "(assert-raise) fails when no raise"
"raise expected:<a> but was:<no raise in body>"
(assert-raise 'a (lambda ()
(+ 1 1))))
(+ 1 1))))

(test-case "(assert-raise) on unbound global variable"
(assert-raise "unbound variable (unbound-global-variable)" (lambda ()
(unbound-global-variable))))
(unbound-global-variable))))

(test-case "(assert-raise) on type error"
(assert-raise "bad argument type (1)" (lambda ()
(+ 1 "1"))))
(+ 1 "1"))))

(test-case "(assert-all) allows several assertions"
(assert-all
(assert-true #t)
(assert-true #t)))
(assert-all (assert-true #t)
(assert-true #t)))

(test-failure "(assert-all) evals all assertions"
"expected:<true> but was:<false>"
(lambda ()
(test-case "- inside assert-all"
(assert-all
(assert-true #t)
(assert-true #f)))))
(assert-all (assert-true #t)
(assert-true #f)))))

(test-case "(test-case) allows several assertions"
(assert-true #t)
Expand Down
85 changes: 55 additions & 30 deletions test/assert-test.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,58 +40,85 @@
"in range expected:<[.99-1.01]> but was:<1.1>"
(assert-inexact= 1. 1.1 0.01))

(test-case "(assert-list-deep=)"
(assert-list-deep= number->string
(test-case "(assert-list=)"
(assert-list= number->string
=
(list 1 2)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on wrong element"
(test-failure "(assert-list=) fails on wrong element"
"2. item expected:<3> but was:<2>"
(assert-list-deep= number->string
(assert-list= number->string
=
(list 1 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on short list"
(test-failure "(assert-list=) fails on short list"
"3. item expected:<more elements> but was:<no more elements>"
(assert-list-deep= number->string
(assert-list= number->string
=
(list 1 2 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on long list"
(test-failure "(assert-list=) fails on long list"
"2. item expected:<no more elements> but was:<more elements>"
(assert-list-deep= number->string
(assert-list= number->string
=
(list 1)
(list 1 2)))

(test-case "(assert-list-deep=)"
(assert-list-deep= number->string
=
(list 1 2)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on wrong element"
"2. item expected:<3> but was:<2>"
(assert-list-deep= number->string
=
(list 1 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on short list"
"3. item expected:<more elements> but was:<no more elements>"
(assert-list-deep= number->string
=
(list 1 2 3)
(list 1 2)))

(test-failure "(assert-list-deep=) fails on long list"
"2. item expected:<no more elements> but was:<more elements>"
(assert-list-deep= number->string
=
(list 1)
(list 1 2)))

(test-case "(assert-list-deep=) recursive"
(assert-list-deep= number->string
=
(list 1 (list 2 3))
(list 1 (list 2 3))))
=
(list 1 (list 2 3))
(list 1 (list 2 3))))

(test-failure "(assert-list-deep=) recursive fails on wrong element type"
"2. item expected:<a sublist> but was:<no sublist>"
(assert-list-deep= number->string
=
(list 1 (list 3))
(list 1 2)))
=
(list 1 (list 3))
(list 1 2)))

(test-failure "(assert-list-deep=) recursive fails on wrong element"
"22. item expected:<3> but was:<4>"
(assert-list-deep= number->string
=
(list 1 (list 2 3))
(list 1 (list 2 4))))
=
(list 1 (list 2 3))
(list 1 (list 2 4))))

(test-case "(assert-list-deep=) with strings"
(assert-list-deep= values
string=?
(list "a")
(list "a"))
string=?
(list "a")
(list "a"))
(assert-string-list= (list "a")
(list "a")))

Expand Down Expand Up @@ -145,38 +172,36 @@

(test-case "(assert-raise) on error string"
(assert-raise "a" (lambda ()
(error "a"))))
(error "a"))))

(test-failure "(assert-raise) fails"
"raise expected:<a> but was:<b>"
(assert-raise 'a (lambda ()
(raise 'b))))
(raise 'b))))

(test-failure "(assert-raise) fails when no raise"
"raise expected:<a> but was:<no raise in body>"
(assert-raise 'a (lambda ()
(+ 1 1))))
(+ 1 1))))

(test-case "(assert-raise) on unbound global variable"
(assert-raise 'unbound-global-variable (lambda ()
(unbound-global-variable))))
(unbound-global-variable))))

(test-case "(assert-raise) on type error"
(assert-raise "expected number" (lambda ()
(+ 1 "1"))))

(test-case "(assert-all) allows several assertions"
(assert-all
(assert-true #t)
(assert-true #t)))
(assert-all (assert-true #t)
(assert-true #t)))

(test-failure "(assert-all) evals all assertions"
"expected:<true> but was:<false>"
(lambda ()
(test-case "- inside assert-all"
(assert-all
(assert-true #t)
(assert-true #f)))))
(assert-all (assert-true #t)
(assert-true #f)))))

(test-case "(test-case) allows several assertions"
(assert-true #t)
Expand Down

0 comments on commit 38fad46

Please sign in to comment.