# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1478435334 0
# Node ID 96febb435c8348f7ed1b018982d4700bfe2d2e60
# Parent  c3d408862ac3cc78fe474e8f21acedcbc948d4d6
Add test scaffolding

diff -r c3d408862ac3 -r 96febb435c83 Makefile
--- a/Makefile	Sat Nov 05 19:36:53 2016 +0000
+++ b/Makefile	Sun Nov 06 12:28:54 2016 +0000
@@ -1,4 +1,4 @@
-.PHONY: vendor
+.PHONY: vendor test test-sbcl test-ccl test-ecl test-abcl
 
 # Vendor ----------------------------------------------------------------------
 vendor/quickutils.lisp: vendor/make-quickutils.lisp
@@ -6,3 +6,22 @@
 
 vendor: vendor/quickutils.lisp
 
+
+# Testing ---------------------------------------------------------------------
+test: test-sbcl test-ccl test-ecl test-abcl
+
+test-sbcl:
+	echo; figlet -kf computer 'SBCL' | sed -Ee 's/ +$$//' | tr -s '\n' | lolcat --freq=0.25; echo
+	ros run -L sbcl --load test/run.lisp
+
+test-ccl:
+	echo; figlet -kf slant 'CCL' | sed -Ee 's/ +$$//' | tr -s '\n' | lolcat --freq=0.25; echo
+	ros run -L ccl-bin --load test/run.lisp
+
+test-ecl:
+	echo; figlet -kf roman 'ECL' | sed -Ee 's/ +$$//' | tr -s '\n' | lolcat --freq=0.25; echo
+	ros run -L ecl --load test/run.lisp
+
+test-abcl:
+	echo; figlet -kf broadway 'ABCL' | sed -Ee 's/ +$$//' | tr -s '\n' | lolcat --freq=0.25; echo
+	abcl --load test/run.lisp
diff -r c3d408862ac3 -r 96febb435c83 cl-digraph.asd
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cl-digraph.asd	Sun Nov 06 12:28:54 2016 +0000
@@ -0,0 +1,35 @@
+(asdf:defsystem :cl-digraph
+  :name "digraph"
+  :description "Simple directed graphs for Common Lisp."
+
+  :author "Steve Losh <steve@stevelosh.com>"
+
+  :license "MIT/X11"
+  :version "1.0.0"
+
+  :depends-on ()
+
+  :serial t
+  :components ((:module "vendor" :serial t
+                :components ((:file "quickutils-package")
+                             (:file "quickutils")))
+               (:file "package")
+               (:module "src" :serial t
+                :components ((:file "directed-graph")))))
+
+
+
+(asdf:defsystem #:digraph-test
+  :name "digraph-test"
+
+  :depends-on (#:1am)
+
+  :serial t
+  :components ((:file "package-test")
+               (:module "test"
+                :serial t
+                :components ((:file "tests"))))
+
+  :perform (asdf:test-op
+             (op system)
+             (uiop:symbol-call :digraph-test :run-tests)))
diff -r c3d408862ac3 -r 96febb435c83 cl-directed-graph.asd
--- a/cl-directed-graph.asd	Sat Nov 05 19:36:53 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,18 +0,0 @@
-(asdf:defsystem :cl-digraph
-  :name "digraph"
-  :description "Simple directed graphs for Common Lisp."
-
-  :author "Steve Losh <steve@stevelosh.com>"
-
-  :license "MIT/X11"
-  :version "1.0.0"
-
-  :depends-on ()
-
-  :serial t
-  :components ((:module "vendor" :serial t
-                :components ((:file "quickutils-package")
-                             (:file "quickutils")))
-               (:file "package")
-               (:module "src" :serial t
-                :components ((:file "directed-graph")))))
diff -r c3d408862ac3 -r 96febb435c83 package-test.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/package-test.lisp	Sun Nov 06 12:28:54 2016 +0000
@@ -0,0 +1,7 @@
+(defpackage :digraph-test
+  (:use
+    :cl
+    :1am
+    :digraph)
+  (:export
+    :run-tests))
diff -r c3d408862ac3 -r 96febb435c83 src/directed-graph.lisp
--- a/src/directed-graph.lisp	Sat Nov 05 19:36:53 2016 +0000
+++ b/src/directed-graph.lisp	Sun Nov 06 12:28:54 2016 +0000
@@ -1,16 +1,36 @@
 (in-package :digraph)
 
 
+
+;;;; Utils --------------------------------------------------------------------
+(defun make-hash-table-portably (&key size test hash-function)
+  ;; Only try to pass :hash-function if we were given it, so we don't explode in
+  ;; implementations that don't support it.
+  ;;
+  ;; Also, use `apply` instead of a simple `if` because we don't want spurious
+  ;; compiler warnings...  This is ugly.
+  (apply #'make-hash-table :test test :size size
+         (if hash-function
+           (list :hash-function hash-function)
+           '())))
+
+
 ;;;; Data ---------------------------------------------------------------------
 (defclass digraph ()
   ((nodes :initarg :nodes :accessor digraph-nodes)
-   (test :initarg :test :accessor digraph-test)))
+   (test :initarg :test :accessor digraph-test)
+   (hash-function :initarg :hash-function :accessor digraph-hash-function)))
 
-(defun make-digraph (&key (test #'eql) initial-vertices)
+(defun make-digraph (&key initial-vertices
+                     (test #'eql)
+                     (hash-function nil))
   (let ((digraph (make-instance 'digraph
-                   :nodes (make-hash-table :test test
-                                           :size (length initial-vertices))
-                   :test test)))
+                   :nodes (make-hash-table-portably
+                            :test test
+                            :size (length initial-vertices)
+                            :hash-function hash-function)
+                   :test test
+                   :hash-function hash-function)))
     (mapc (curry #'insert-vertex digraph) initial-vertices)
     digraph))
 
@@ -26,13 +46,6 @@
   `(cdr (gethash ,object (digraph-nodes ,digraph))))
 
 
-(defun copy-digraph (digraph)
-  ;; todo make this faster, but at least this works
-  (let ((copy (make-digraph :test (digraph-test digraph)
-                            :initial-vertices (vertices digraph))))
-    (do-edges (p s digraph) (insert-edge digraph p s))
-    copy))
-
 
 ;;;; Basic API ----------------------------------------------------------------
 (defun vertices (digraph)
@@ -109,10 +122,10 @@
     :do (progn ,@body)))
 
 (defmacro do-edges ((predecessor-symbol successor-symbol digraph) &body body)
-  (with-gensyms (preds succs)
+  (with-gensyms (succs)
     `(loop
       :for ,predecessor-symbol :being :the hash-keys :of (digraph-nodes ,digraph)
-      :using (hash-value (,preds . ,succs))
+      :using (hash-value (nil . ,succs))
       :do (loop :for ,successor-symbol :in ,succs ; i miss u, iterate
                 :do (progn ,@body)))))
 
@@ -143,6 +156,14 @@
            (digraph-nodes digraph))
   (values))
 
+;;;; Copying ------------------------------------------------------------------
+(defun copy-digraph (digraph)
+  ;; todo make this faster, but at least this works
+  (let ((copy (make-digraph :test (digraph-test digraph)
+                            :initial-vertices (vertices digraph))))
+    (do-edges (p s digraph) (insert-edge digraph p s))
+    copy))
+
 
 ;;;; Scratch ------------------------------------------------------------------
 (defparameter *d* (make-digraph))
@@ -156,4 +177,4 @@
 
 (remove-edge *d* 'a 'a)
 (remove-vertex *d* 'a)
-(dump *d*)
+; (dump *d*)
diff -r c3d408862ac3 -r 96febb435c83 test/run.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/run.lisp	Sun Nov 06 12:28:54 2016 +0000
@@ -0,0 +1,5 @@
+#+ecl (setf compiler:*user-cc-flags* "-Wno-shift-negative-value")
+
+(ql:quickload 'cl-digraph)
+(time (asdf:test-system 'cl-digraph))
+(quit)
diff -r c3d408862ac3 -r 96febb435c83 test/tests.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/tests.lisp	Sun Nov 06 12:28:54 2016 +0000
@@ -0,0 +1,9 @@
+(in-package :digraph-test)
+
+(defmacro define-test (name &body body)
+  `(test ,name
+    (let ((*package* ,*package*))
+      ,@body)))
+
+(defun run-tests ()
+  (1am:run))