Skip to content

Instantly share code, notes, and snippets.

@katzchang

katzchang/Makefile

Last active October 13, 2015 20:28
Show Gist options
  • Save katzchang/4251773 to your computer and use it in GitHub Desktop.
Save katzchang/4251773 to your computer and use it in GitHub Desktop.
Download ZIP
gauche unitを書いた
Raw
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なんとかにしないといけないっぽいところです?

Raw
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.")))
Raw
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"))
Raw
Makefile
GOSH=/usr/local/bin/gosh
L=./gu.scm
test:
$(GOSH) -l $(L) ./*test.scm
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment