[Cl-darcs-cvs] r179 - in cl-darcs/trunk: . tests

[mhenoch at common-lisp.net]

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))
+