gauche unitを書いた

README.md

このgistは TDD Advent Calender 2012, 12/10 のエントリとして書かれたような気がします。昨日、12/9のエントリは @setoazusa さんの JUnitテストの実行環境をバージョンアップする時の落とし穴 #tddadventjp – ふぃーるどのーつ@はてな だったそうです。

そう、だれがJSTに従うと言った?

さて、私はいま社内読書会として 計算機プログラムの構造と解釈、通称SICP ってやつを読んでいて、ちょうど2章がもう少しで終わるかなーというところなんですが、その中ではデータ構造の操作だったりをする手続き(「関数」とは言わない)を作ったりして、それを「accumulatorを使うように直してみよう」みたいな感じで、 手続きの構造を変更 させられるわけで、もちろんそのときは、 手続きの入出力が変わらない ようにしなければならない。ようするに リファクタリング以外の何者でもないわけですよ、これは。

ということで、何が必要かって、 テストコードが必要 ですよね、よく訓練されたおまいらには当然ですね。

という感じで書いたのがコレなので、動かすには、gaucheがインストールされている状態で

git clone git://gist.github.com/4251773.git gist-4251773
cd gist-4251773
make test

してみてください。テストがこけてれば、makeもこけます。試しに、テストコードの9,10行目のコメントを外してみてください。例外が投げられないという例外が投げられ、makeがこけます：

(assert (lazy (assert (+ 1 2) (is 3)))
 (raises "expected: 2, but: was 3")) ; error

gaucheにも組み込みでtestなんとかがあるらしいけど、このへんはアレですね、使い慣れた感じのほうがね。再発明とか気にしないの。これは訓練である。これは訓練である。

12/11は @bash0C7 先生による ハイプレッシャーを克服するためのテスト駆動開発の重要な「二歩目」 です。これも大変いい話ですね。

以上、よろしくお願い致します。

ポイントは、raises matcherのときのactualはlazyなんとかにしないといけないっぽいところです?

gu.scm

;; assertion
(define (assert actual matcher)
  (define (match? matcher actual) ((car matcher) actual))
  (define (description-of matcher) (cadr matcher))
  (define (describe-mismatch matcher actual) ((caddr matcher) actual))
  (define (describe matcher actual)
    (string-append "expected: " (description-of matcher) ", but: " (describe-mismatch matcher actual)))
  (if (match? matcher actual)
      #t
      (raise (describe matcher actual))))

(define default-mismatch-messenger
  (lambda (actual) (string-append "was " (x->string actual))))

;; is matcher
(define (is expected)
    (list
     (lambda (actual) (equal? expected actual))
     (x->string expected)
     default-mismatch-messenger))

;; contains matcher
(define (contains expected)
  (define (contains? item list)
    (if (any (lambda (e) (equal? e item)) list) #t #f))
  (list
   (lambda (actual) (contains? expected actual))
   (string-append "contains " (x->string expected))
   default-mismatch-messenger))

;; is greater than matcher
(define (is-greater-than expected)
  (let ((test? (cond ((number? expected) <)
		     ((string? expected) string<?)
		     (else (lambda (e a) (raise (string-append "can not compare " (x->string e) " and " (x->string a))))))))
    (list
     (lambda (actual) (test? expected actual))
     (string-append "greater than " (x->string expected))
     default-mismatch-messenger)))

;; raises matcher
(define (raises expected)
  (list
   (lambda (promise-actual)
     (if (promise? promise-actual)
	 (guard (exc
		 ((string? exc) (equal? exc expected))
		 (else #f))
		(not (force promise-actual)))
	 (raise "actual must be a promise.")))
     (string-append "raises '" (x->string expected) "'")
     (lambda (actual) "not be raised.")))

gu_test.scm

;(load "./gu.scm")

; raises test
(assert (lazy (raise "foo"))
	(raises "foo"))
(assert (lazy (assert (lazy (raise "foo")) (raises "bar")))
	(raises "expected: raises 'bar', but: not be raised."))

;(assert (lazy (assert (+ 1 2) (is 3)))
;	(raises "expected: 2, but: was 3")) ; error


; is test
(assert (= 1 1) (is #t)) ; #t
(assert (lazy (assert (= 1 1) (is #f)))
	(raises "expected: #f, but: was #t"))

(assert (+ 1 2) (is 3)) ; #t
(assert (lazy (assert (+ 1 2) (is 4)))
	(raises "expected: 4, but: was 3"))

(assert (substring "ahoge" 1 5) (is "hoge")) ; #t
(assert (lazy (assert (substring "ahoge" 1 5) (is "hage")))
	(raises "expected: hage, but: was hoge"))

(assert (list) (is '()))
(assert (lazy (assert (list) (is "hoge")))
	(raises "expected: hoge, but: was ()"))
(assert (make-list 3 "hoge") (is (list "hoge" "hoge" "hoge")))
(assert (lazy (assert (+ 1 1) (is "hoge")))
	(raises "expected: hoge, but: was 2"))

(assert (lazy (assert (+ 1 1) (is "2")))
	(raises "expected: 2, but: was 2")) ; TODO: unko discription

; contains test
(assert (list "hoge" "fuga") (contains "fuga")) ; #t
(assert (lazy (assert (list "hoge" "fuga") (contains "hage")))
	(raises "expected: contains hage, but: was (hoge fuga)"))

; is greater
(assert (+ 1 2) (is-greater-than 2)) ; #t
(assert (lazy (assert (+ 1 2) (is-greater-than 3)))
	(raises "expected: greater than 3, but: was 3"))
(assert (lazy (assert (+ 1 2) (is-greater-than 4)))
	(raises "expected: greater than 4, but: was 3"))
	
(assert "hoge" (is-greater-than "hage"))
(assert (lazy (assert "hage" (is-greater-than "hoge")))
	(raises "expected: greater than hoge, but: was hage"))
(assert (lazy (assert #t (is-greater-than #f)))
	(raises "can not compare #f and #t"))

Makefile

GOSH=/usr/local/bin/gosh
L=./gu.scm

test:
	$(GOSH) -l $(L) ./*test.scm