mirror of
https://github.com/emilybache/GildedRose-Refactoring-Kata.git
synced 2025-12-12 04:12:13 +00:00
Adds foo test with minimal assertion library.
This commit is contained in:
parent
1c530189bd
commit
745c004a8b
58
scheme/assert.scm
Normal file
58
scheme/assert.scm
Normal file
@ -0,0 +1,58 @@
|
|||||||
|
;;;
|
||||||
|
;;; Unit test framework for Scheme
|
||||||
|
;;; Copyright (c) 2018, Peter Kofler, http://www.code-cop.org/
|
||||||
|
;;; BSD licensed.
|
||||||
|
;;;
|
||||||
|
;;; Non S5RS used functions:
|
||||||
|
;;; * (error) from R6RS
|
||||||
|
;;;
|
||||||
|
|
||||||
|
;; SchemeUnit from http://c2.com/cgi/wiki?SchemeUnit
|
||||||
|
|
||||||
|
(define (fail msg)
|
||||||
|
(error (string-append "AssertionError" ": " msg)))
|
||||||
|
|
||||||
|
(define (check msg condition)
|
||||||
|
(if (not condition)
|
||||||
|
(fail msg)
|
||||||
|
#t))
|
||||||
|
|
||||||
|
(define (assert msg condition)
|
||||||
|
(lambda () (check msg condition)))
|
||||||
|
|
||||||
|
;; extensions
|
||||||
|
|
||||||
|
;; private
|
||||||
|
(define (make-string-message prefix to-string expected actual)
|
||||||
|
(make-message prefix
|
||||||
|
(to-string expected)
|
||||||
|
(to-string actual)))
|
||||||
|
|
||||||
|
;; private
|
||||||
|
(define (make-message prefix expected actual)
|
||||||
|
(string-append prefix "expected:<" expected "> but was:<" actual ">"))
|
||||||
|
|
||||||
|
(define (assert-equal to-string eq-op expected actual)
|
||||||
|
(assert (make-string-message "" to-string expected actual)
|
||||||
|
(eq-op expected actual)))
|
||||||
|
|
||||||
|
(define (assert= expected actual)
|
||||||
|
(assert-equal number->string = expected actual))
|
||||||
|
|
||||||
|
(define (assert-string= expected actual)
|
||||||
|
(assert-equal values string=? expected actual))
|
||||||
|
|
||||||
|
;; private
|
||||||
|
(define (test-case-name name)
|
||||||
|
(display name)
|
||||||
|
(display " ... "))
|
||||||
|
|
||||||
|
;; private
|
||||||
|
(define (test-case-success)
|
||||||
|
(display "OK")
|
||||||
|
(newline))
|
||||||
|
|
||||||
|
(define (test-case name . assertions)
|
||||||
|
(test-case-name name)
|
||||||
|
(for-each (lambda (a) (a)) assertions)
|
||||||
|
(test-case-success))
|
||||||
7
scheme/gilded-rose-test.scm
Normal file
7
scheme/gilded-rose-test.scm
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
(include "assert.scm")
|
||||||
|
(include "gilded-rose.scm")
|
||||||
|
|
||||||
|
(test-case "foo"
|
||||||
|
(let ((items (list (make-item "foo" 0 0))))
|
||||||
|
(update-quality items)
|
||||||
|
(assert-string= "fixme" (item-name (car items)))))
|
||||||
Loading…
Reference in New Issue
Block a user