Author: mhenoch Date: Sun Mar 23 19:38:36 2008 New Revision: 179 Added: cl-darcs/trunk/tests/ cl-darcs/trunk/tests/gcau-tests.lisp cl-darcs/trunk/tests/package.lisp Modified: cl-darcs/trunk/cl-darcs.asd cl-darcs/trunk/repo.lisp Log: Add test suite Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Sun Mar 23 19:38:36 2008 @@ -64,3 +64,21 @@ #+allegro (eval-when (:compile-toplevel :load-toplevel :execute) (require :inflate)) + +(defmethod perform ((o test-op) (c (eql (find-system 'cl-darcs)))) + (operate 'load-op 'cl-darcs-tests) + (operate 'test-op 'cl-darcs-tests :force t)) + +(defsystem cl-darcs-tests + :depends-on (cl-darcs fiveam) + :components + ((:module "tests" + :components ((:file "package") + (:file "gcau-tests"))))) + +(defmethod perform ((o test-op) (c (eql (find-system 'cl-darcs-tests)))) + (operate 'load-op 'cl-darcs-tests) + (funcall (intern (symbol-name '#:run!) + (find-package '#:darcs-tests)) + (intern (symbol-name '#:darcs-suite) + (find-package '#:darcs-tests)))) \ No newline at end of file Modified: cl-darcs/trunk/repo.lisp ============================================================================== --- cl-darcs/trunk/repo.lisp (original) +++ cl-darcs/trunk/repo.lisp Sun Mar 23 19:38:36 2008 @@ -158,6 +158,7 @@ (write-patchinfo patchinfo strout))) (write-byte 10 f))) +;; See also tests/gcau-tests.lisp (defun get-common-and-uncommon (ours theirs) "Given patchsets OURS and THEIRS, find common and uncommon patches. OURS and THEIRS are lists of lists of patchinfos, as returned by Added: cl-darcs/trunk/tests/gcau-tests.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/tests/gcau-tests.lisp Sun Mar 23 19:38:36 2008 @@ -0,0 +1,58 @@ +;;; Copyright (C) 2008 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(in-package :darcs-tests) + +(def-suite get-common-and-uncommon-suite :in darcs-suite) +(in-suite get-common-and-uncommon-suite) + +(defun gen-patchinfo () + (darcs::make-patchinfo :name (format nil "~A" (random 1000)))) + +(defmacro tri-equal (form one two three) + `(multiple-value-bind (one two three) ,form + (is (equal ,one one)) + (is (equal ,two two)) + (is (equal ,three three)))) + +(test gcau-nil + (tri-equal (darcs::get-common-and-uncommon nil nil) + nil nil nil)) + +(test gcau-only-common + (for-all ((patchinfos (gen-list :elements #'gen-patchinfo))) + (tri-equal (darcs::get-common-and-uncommon (list patchinfos) (list patchinfos)) + patchinfos nil nil))) + +(test gcau-only-ours + (for-all ((patchinfos (gen-list :elements #'gen-patchinfo))) + (tri-equal (darcs::get-common-and-uncommon (list patchinfos) nil) + nil patchinfos nil))) + +(test gcau-only-theirs + (for-all ((patchinfos (gen-list :elements #'gen-patchinfo))) + (tri-equal (darcs::get-common-and-uncommon nil (list patchinfos)) + nil nil patchinfos))) + +(test gcau-both + (for-all ((common (gen-list :elements #'gen-patchinfo)) + (only-ours (gen-list :elements #'gen-patchinfo)) + (only-theirs (gen-list :elements #'gen-patchinfo))) + (let ((ours (list (append common only-ours))) + (theirs (list (append common only-theirs)))) + (tri-equal (darcs::get-common-and-uncommon ours theirs) + common only-ours only-theirs)))) + Added: cl-darcs/trunk/tests/package.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/tests/package.lisp Sun Mar 23 19:38:36 2008 @@ -0,0 +1,24 @@ +;;; Copyright (C) 2008 Magnus Henoch +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(defpackage :darcs-tests + (:use :cl :darcs :it.bese.FiveAM)) + +(in-package :darcs-tests) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (make-suite 'darcs-suite)) +