-
간단한 데이타베이스를 TDD 로 개발하기 소스 코드Programmer/Programming 2014. 3. 19. 10:04
아래는 간단한 데이타베이스를 TDD로 개발하기의 최종 결과물이다.
cd-db.lisp
(defpackage :cd-db (:use :common-lisp) (:export #:dump-db #:drop-db #:make-record #:add-record #:save-db #:load-db #:where #:select #:update #:make-comparison-expr #:make-comparisons-list #:delete-records)) (in-package :cd-db) (defvar *db* nil) (defun dump-db () *db*) (defun drop-db () (setf *db* nil)) (defun make-record (title artist rating ripped) (list :title title :artist artist :rating rating :ripped ripped)) (defun add-record (record) (push record *db*)) (defun save-db (filename) (with-open-file (out filename :direction :output :if-exists :supersede) (with-standard-io-syntax (print *db* out)))) (defun load-db (filename) (with-open-file (in filename) (with-standard-io-syntax (setf *db* (read in))))) (defun select (selector-fn) (remove-if-not selector-fn *db*)) (defun update (selector-fn &key title artist rating (ripped nil ripped-p)) (setf *db* (mapcar #'(lambda (record) (when (funcall selector-fn record) (if title (setf (getf record :title) title)) (if artist (setf (getf record :artist) artist)) (if rating (setf (getf record :rating) rating)) (if ripped-p (setf (getf record :ripped) ripped))) record) *db*))) (defun make-comparison-expr (field value) `(equal (getf record ,field) ,value)) (defun make-comparisons-list (fields) (loop while fields collecting (make-comparison-expr (pop fields) (pop fields)))) (defmacro where (&rest clauses) `#'(lambda (record) (and ,@(make-comparisons-list clauses)))) (defun delete-records (selector-fn) (setf *db* (remove-if selector-fn *db*)))
cd-test.lisp
(ql:quickload "lisp-unit") (defpackage :cd-tests (:use :common-lisp :lisp-unit :cd-db)) (in-package :cd-tests) ;; '((:title "Lyle Lovett" :artist "Lyle Lovett" :rating 9 :ripped t) ;; (:title "Give Us a Break" :artist "Limpopo" :rating 10 :ripped t) ;; (:title "Rockin' the Suburbs" :artist "Ben Folds" :rating 6 :ripped t) ;; (:title "Home" :artist "Dixie Chicks" :rating 9 :ripped t) ;; (:title "Fly" :artist "Dixie Chicks" :rating 8 :ripped t) ;; (:title "Roses" :artist "Kathy Mattea" :rating 9 :ripped t)) (defun add-all-records () (add-record (make-record "Lyle Lovett" "Lyle Lovett" 9 t)) (add-record (make-record "Give Us a Break" "Limpopo" 10 t)) (add-record (make-record "Rockin' the Suburbs" "Ben Folds" 6 t)) (add-record (make-record "Home" "Dixie Chicks" 9 t)) (add-record (make-record "Fly" "Dixie Chicks" 8 t)) (add-record (make-record "Roses" "Kathy Mattea" 9 t))) (defun sort-db (db) (sort db #'string< :key #'cadr)) (define-test make-record-test (assert-equal '(:title "Home" :artist "Dixie Chicks" :rating 9 :ripped t) (make-record "Home" "Dixie Chicks" 9 t)) (assert-equal '(:title "Roses" :artist "Kathy Mattea" :rating 7 :ripped t) (make-record "Roses" "Kathy Mattea" 7 t))) (define-test add-record-test (drop-db) (add-record (make-record "Home" "Dixie Chicks" 9 t)) (assert-equal (sort-db '((:title "Home" :artist "Dixie Chicks" :rating 9 :ripped t))) (sort-db (dump-db))) (add-record (make-record "Roses" "Kathy Mattea" 7 t)) (assert-equal (sort-db '((:title "Roses" :artist "Kathy Mattea" :rating 7 :ripped t) (:title "Home" :artist "Dixie Chicks" :rating 9 :ripped t))) (sort-db (dump-db)))) (define-test save-and-load-db-test (drop-db) (add-record (make-record "Home" "Dixie Chicks" 9 t)) (add-record (make-record "Roses" "Kathy Mattea" 7 t)) (let ((db-file "save-and-load-db-test.db")) (save-db db-file) (drop-db) (load-db db-file)) (assert-equal (sort-db (list (make-record "Roses" "Kathy Mattea" 7 t) (make-record "Home" "Dixie Chicks" 9 t))) (sort-db (dump-db)))) (define-test select-test (drop-db) (add-all-records) (assert-equal (sort-db (list (make-record "Home" "Dixie Chicks" 9 t) (make-record "Fly" "Dixie Chicks" 8 t))) (sort-db (select (where :artist "Dixie Chicks" :ripped t)))) (assert-equal (sort-db (list (make-record "Give Us a Break" "Limpopo" 10 t))) (sort-db (select (where :title "Give Us a Break")))) (assert-equal (sort-db (list (make-record "Home" "Dixie Chicks" 9 t))) (sort-db (select (where :artist "Dixie Chicks" :rating 9)))) (assert-equal (sort-db '()) (sort-db (select (where :artist "Dixie Chicks" :rating 11))))) (define-test update-test (drop-db) (add-all-records) (update (where :artist "Dixie Chicks" :ripped t) :artist "Limpopo") (assert-equal (sort-db (list (make-record "Lyle Lovett" "Lyle Lovett" 9 t) (make-record "Give Us a Break" "Limpopo" 10 t) (make-record "Rockin' the Suburbs" "Ben Folds" 6 t) (make-record "Home" "Limpopo" 9 t) (make-record "Fly" "Limpopo" 8 t) (make-record "Roses" "Kathy Mattea" 9 t))) (sort-db (dump-db))) (drop-db) (add-all-records) (update (where :title "Give Us a Break") :artist "Dixie Chicks" :rating 11) (assert-equal (sort-db (list (make-record "Lyle Lovett" "Lyle Lovett" 9 t) (make-record "Give Us a Break" "Dixie Chicks" 11 t) (make-record "Rockin' the Suburbs" "Ben Folds" 6 t) (make-record "Home" "Dixie Chicks" 9 t) (make-record "Fly" "Dixie Chicks" 8 t) (make-record "Roses" "Kathy Mattea" 9 t))) (sort-db (dump-db)))) (define-test make-comparison-expr-test (assert-equal (make-comparison-expr :artist "Dixie Chicks") '(equal (getf cd-db::record :artist) "Dixie Chicks")) (assert-equal (make-comparison-expr :title "Roses") '(equal (getf cd-db::record :title) "Roses"))) (define-test make-comparisons-list-test (assert-equal (make-comparisons-list '(:artist "Dixie Chicks" :title "Roses")) '((equal (getf cd-db::record :artist) "Dixie Chicks") (equal (getf cd-db::record :title) "Roses")))) (define-test where-test (assert-expands #'(lambda (record) (and (equal (getf record :title) "Home") (equal (getf record :artist) "Dixie Chicks") (equal (getf record :rating) 9) (equal (getf record :ripped) t))) (where :title "Home" :artist "Dixie Chicks" :rating 9 :ripped t)) (assert-expands #'(lambda (record) (and (equal (getf record :artist) "Dixie Chicks"))) (where :artist "Dixie Chicks")) (assert-expands #'(lambda (record) (and (equal (getf record :artist) "Dixie Chicks") (equal (getf record :rating) 9))) (where :artist "Dixie Chicks" :rating 9))) (define-test delete-records-test (drop-db) (add-all-records) (delete-records (where :artist "Dixie Chicks" :ripped t)) (assert-equal (sort-db (list (make-record "Lyle Lovett" "Lyle Lovett" 9 t) (make-record "Give Us a Break" "Limpopo" 10 t) (make-record "Rockin' the Suburbs" "Ben Folds" 6 t) (make-record "Roses" "Kathy Mattea" 9 t))) (sort-db (dump-db))) (drop-db) (add-all-records) (delete-records (where :artist "Dixie Chicks" :rating 9)) (assert-equal (sort-db (list (make-record "Lyle Lovett" "Lyle Lovett" 9 t) (make-record "Give Us a Break" "Limpopo" 10 t) (make-record "Rockin' the Suburbs" "Ben Folds" 6 t) (make-record "Fly" "Dixie Chicks" 8 t) (make-record "Roses" "Kathy Mattea" 9 t))) (sort-db (dump-db))) (drop-db) (add-all-records) (delete-records (where :artist "Dixie Chicks" :rating 11)) (assert-equal (sort-db (list (make-record "Lyle Lovett" "Lyle Lovett" 9 t) (make-record "Give Us a Break" "Limpopo" 10 t) (make-record "Rockin' the Suburbs" "Ben Folds" 6 t) (make-record "Home" "Dixie Chicks" 9 t) (make-record "Fly" "Dixie Chicks" 8 t) (make-record "Roses" "Kathy Mattea" 9 t))) (sort-db (dump-db)))) ;; (in-package :cd-tests) ;; (setq *print-failures* t) ;; (lisp-unit:remove-tests :all) ;; (lisp-unit:run-tests :all) ;; (lisp-unit:run-all-tests :cd-tests)
'Programmer > Programming' 카테고리의 다른 글
테스트 주도 방식으로 리스프 매크로 작성하기 (0) 2014.06.05 MAPCAR와 그 친구들(MAPC, MAPCAN) (0) 2014.05.30 간단한 데이타베이스를 TDD 로 개발하기 3회: add-record (0) 2014.03.19 간단한 데이타베이스를 TDD 로 개발하기 2회: make-cd (0) 2014.03.19 간단한 데이타베이스를 TDD 로 개발하기 1회: dump-db (0) 2014.03.19 댓글