# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468503057 0
# Node ID 5c914fbcb042c256449672360b6e6a21f2da2b29
# Parent  8cfac0fbe30de146efda74ce023d001e462fe407
Switch to 1am, test under ECL too

diff -r 8cfac0fbe30d -r 5c914fbcb042 Makefile
--- a/Makefile	Wed Jul 13 23:36:51 2016 +0000
+++ b/Makefile	Thu Jul 14 13:30:57 2016 +0000
@@ -1,19 +1,28 @@
-.PHONY: test pubdocs bench profile
+.PHONY: test pubdocs bench profile test-sbcl test-ccl test-ecl
 
 sourcefiles = $(shell ffind --full-path --dir src --literal .lisp)
 docfiles = $(shell ls docs/*.markdown)
 apidoc = docs/03-reference.markdown
 
-test:
-	figlet -kf big 'SBCL'
+test: test-sbcl test-ccl test-ecl
+
+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
 
-	figlet -kf big 'CCL'
+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
+
+
 src/quickutils.lisp: src/make-quickutils.lisp
 	cd src && sbcl-rlwrap --noinform --load make-quickutils.lisp  --eval '(quit)'
 
+
 $(apidoc): $(sourcefiles) docs/api.lisp
 	sbcl-rlwrap --noinform --load docs/api.lisp  --eval '(quit)'
 
@@ -28,6 +37,7 @@
 	hg -R ~/src/sjl.bitbucket.org commit -Am 'bones: Update site.'
 	hg -R ~/src/sjl.bitbucket.org push
 
+
 bench:
 	sbcl-rlwrap --noinform --load examples/bench.lisp  --eval '(quit)'
 
diff -r 8cfac0fbe30d -r 5c914fbcb042 bones-test.asd
--- a/bones-test.asd	Wed Jul 13 23:36:51 2016 +0000
+++ b/bones-test.asd	Thu Jul 14 13:30:57 2016 +0000
@@ -3,7 +3,7 @@
   :author "Steve Losh <steve@stevelosh.com>"
   :license "MIT/X11"
   :depends-on (#:bones
-               #:fiveam)
+               #:1am)
   :serial t
   :components ((:file "package-test")
                (:module "test"
diff -r 8cfac0fbe30d -r 5c914fbcb042 package-test.lisp
--- a/package-test.lisp	Wed Jul 13 23:36:51 2016 +0000
+++ b/package-test.lisp	Thu Jul 14 13:30:57 2016 +0000
@@ -1,23 +1,20 @@
 (defpackage #:bones-test
   (:use
     #:cl
-    #:5am
+    #:1am
     ))
 
 (defpackage #:bones-test.paip
   (:use
     #:cl
-    #:5am
+    #:1am
     #:bones.quickutils
-    #:bones.paip)
-  ; kill me
-  (:shadowing-import-from #:5am
-    #:fail))
+    #:bones.paip))
 
 (defpackage #:bones-test.wam
   (:use
     #:cl
-    #:5am
+    #:1am
     #:bones.quickutils
     #:bones.wam)
   (:import-from #:bones.wam
@@ -39,4 +36,4 @@
     #:!))
 
 (defpackage #:bones-test.circle
-  (:use :cl :5am :bones.circle))
+  (:use :cl :1am :bones.circle))
diff -r 8cfac0fbe30d -r 5c914fbcb042 test/bones.lisp
--- a/test/bones.lisp	Wed Jul 13 23:36:51 2016 +0000
+++ b/test/bones.lisp	Thu Jul 14 13:30:57 2016 +0000
@@ -1,5 +1,1 @@
 (in-package #:bones-test)
-
-(def-suite :bones)
-(in-suite :bones)
-
diff -r 8cfac0fbe30d -r 5c914fbcb042 test/circle.lisp
--- a/test/circle.lisp	Wed Jul 13 23:36:51 2016 +0000
+++ b/test/circle.lisp	Thu Jul 14 13:30:57 2016 +0000
@@ -1,19 +1,16 @@
 (in-package #:bones-test.circle)
 
-(def-suite :bones.circle)
-(in-suite :bones.circle)
-
 (defmacro is-circle-contents (circle values)
   `(is (equal ,values
               (circle-to-list ,circle))))
 
 
 (test empty-circles
-  (is-true (circle-empty-p (make-empty-circle)))
-  (is-true (circle-empty-p (make-circle-with nil)))
-  (is-false (circle-empty-p (make-circle-with (list 1)))))
+  (is (circle-empty-p (make-empty-circle)))
+  (is (circle-empty-p (make-circle-with nil)))
+  (is (not (circle-empty-p (make-circle-with (list 1))))))
 
-(test make-circle-with
+(test making-circle-with
   (is-circle-contents
     (make-circle-with (list))
     nil)
@@ -68,7 +65,7 @@
     (is-circle-contents c '(a b 1 p q))))
 
 
-(test forward
+(test moving-forward
   (let ((c (make-circle-with (list 1 2 3 4))))
     (is (equal
           '(1 2 3 4)
@@ -76,7 +73,7 @@
                 :while node
                 :collect (circle-value node))))))
 
-(test backward
+(test moving-backward
   (let ((c (make-circle-with (list 1 2 3 4))))
     (is (equal
           '(4 3 2 1)
@@ -85,7 +82,7 @@
                 :collect (circle-value node))))))
 
 
-(test rotate
+(test rotating
   (let ((c (make-circle-with (list 1 2 3 4))))
     (is-circle-contents (circle-rotate c 0)
                         '(1 2 3 4))
@@ -118,7 +115,8 @@
     (is-circle-contents (circle-rotate (circle-rotate c 3) -1)
                         '(2 3 4 1))))
 
-(test nth
+
+(test retrieving-nth
   (let* ((data (list 'a 'b 'c 'd))
          (c (make-circle-with data)))
     (loop :for i :from 0 :below 4
@@ -126,7 +124,7 @@
           :do (is (eql v (circle-value (circle-nth c i)))))))
 
 
-(test insert-before
+(test inserting-before
   (let ((c (make-circle-with (list 1 2 3))))
     (circle-insert-before c 'a)
     (is-circle-contents c '(1 2 3 a))
@@ -143,7 +141,7 @@
     (circle-insert-before (circle-nth c -1) 'e)
     (is-circle-contents c '(b c d 1 2 3 e a))))
 
-(test insert-after
+(test inserting-after
   (let ((c (make-circle-with (list 1 2 3))))
     (circle-insert-after c 'a)
     (is-circle-contents c '(a 1 2 3))
@@ -161,19 +159,19 @@
     (is-circle-contents c '(a b c d 1 2 3 x))))
 
 
-(test sentinel-p
+(test checking-sentinel
   (let ((c (make-circle-with (list 1 2 3))))
-    (is-true (circle-sentinel-p c))
-    (is-false (circle-sentinel-p (circle-nth c 0)))
-    (is-false (circle-sentinel-p (circle-nth c 1)))
-    (is-false (circle-sentinel-p (circle-nth c 2)))
-    (is-true (circle-sentinel-p (circle-nth c 3))))
-  (is-true (circle-sentinel-p (make-empty-circle)))
-  (is-true (circle-sentinel-p (circle-nth (make-empty-circle) 0)))
-  (is-true (circle-sentinel-p (circle-nth (make-empty-circle) -1))))
+    (is (circle-sentinel-p c))
+    (is (not (circle-sentinel-p (circle-nth c 0))))
+    (is (not (circle-sentinel-p (circle-nth c 1))))
+    (is (not (circle-sentinel-p (circle-nth c 2))))
+    (is (circle-sentinel-p (circle-nth c 3))))
+  (is (circle-sentinel-p (make-empty-circle)))
+  (is (circle-sentinel-p (circle-nth (make-empty-circle) 0)))
+  (is (circle-sentinel-p (circle-nth (make-empty-circle) -1))))
 
 
-(test remove
+(test removing
   (let ((c (make-circle-with (list 1 2 3))))
     (signals simple-error (circle-remove c))
     (is-circle-contents c '(1 2 3))
@@ -187,14 +185,14 @@
     (circle-remove (circle-nth c 0))
     (is-circle-contents c '())))
 
-(test backward-remove
+(test removing-backward
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
     (is-circle-contents (circle-backward-remove (circle-nth c 1))
                         '(1 3 4 5 6))
 
-    (is-false (circle-backward-remove (circle-nth c 0)))
+    (is (not (circle-backward-remove (circle-nth c 0))))
     (is-circle-contents c '(3 4 5 6))
 
     (is-circle-contents (circle-backward-remove (circle-nth c -1))
@@ -202,18 +200,18 @@
 
     (is-circle-contents c '(3 4 5))))
 
-(test forward-remove
+(test removing-forward
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
     (is-circle-contents (circle-forward-remove (circle-nth c 1))
                         '(3 4 5 6 1))
 
-    (is-false (circle-forward-remove (circle-nth c -1)))
+    (is (not (circle-forward-remove (circle-nth c -1))))
     (is-circle-contents c '(1 3 4 5))))
 
 
-(test replace
+(test replacing
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
@@ -232,7 +230,7 @@
     (circle-replace (circle-nth c -1) 'c)
     (is-circle-contents c '(bar a b 4 5 c))))
 
-(test backward-replace
+(test replacing-backward
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
@@ -245,10 +243,10 @@
     (is-circle-contents (circle-backward-replace (circle-nth c 2) 'a)
                         '(bar a 4 5 6 1))
 
-    (is-false (circle-backward-replace (circle-nth c 0) 'dogs))
+    (is (not (circle-backward-replace (circle-nth c 0) 'dogs)))
     (is-circle-contents c '(dogs bar a 4 5 6))))
 
-(test forward-replace
+(test replacing-forward
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
@@ -258,11 +256,11 @@
     (is-circle-contents (circle-forward-replace (circle-nth c 1) 'bar)
                         '(3 4 5 6 1 bar))
 
-    (is-false (circle-forward-replace (circle-nth c -1) 'cats))
+    (is (not (circle-forward-replace (circle-nth c -1) 'cats)))
     (is-circle-contents c '(1 bar 3 4 5 cats))))
 
 
-(test splice
+(test splicing
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
@@ -278,7 +276,7 @@
     (circle-splice (circle-nth c 3) nil)
     (is-circle-contents c '(a c 2 4 5 dogs cats))))
 
-(test backward-splice
+(test splicing-backward
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
@@ -288,10 +286,10 @@
     (is-circle-contents (circle-backward-splice (circle-nth c -1) '())
                         '(5 1 2 a b 4))
 
-    (is-false (circle-backward-splice (circle-nth c 0) '(first second)))
+    (is (not (circle-backward-splice (circle-nth c 0) '(first second))))
     (is-circle-contents c '(first second 2 a b 4 5))))
 
-(test forward-splice
+(test splicing-forward
   (let ((c (make-circle-with (list 1 2 3 4 5 6))))
     (is-circle-contents c '(1 2 3 4 5 6))
 
@@ -301,5 +299,5 @@
     (is-circle-contents (circle-forward-splice (circle-nth c 1) '())
                         '(2 3 4 5 6 a))
 
-    (is-false (circle-forward-splice (circle-nth c -1) '(last)))
+    (is (not (circle-forward-splice (circle-nth c -1) '(last))))
     (is-circle-contents c '(a 2 3 4 5 last))))
diff -r 8cfac0fbe30d -r 5c914fbcb042 test/paip.lisp
--- a/test/paip.lisp	Wed Jul 13 23:36:51 2016 +0000
+++ b/test/paip.lisp	Thu Jul 14 13:30:57 2016 +0000
@@ -1,9 +1,5 @@
 (in-package #:bones-test.paip)
 
-(def-suite :bones.paip)
-(in-suite :bones.paip)
-
-
 ;;;; Utils
 (defun alist-equal (x y)
   (set-equal x y :test #'equal))
@@ -27,10 +23,10 @@
 
 
 (defmacro proves (query)
-  `(is-true (return-all ,query)))
+  `(is (return-all ,query)))
 
 (defmacro not-proves (query)
-  `(is-false (return-all ,query)))
+  `(is (not (return-all ,query))))
 
 (defmacro proves-with (query results)
   `(is (set-equal ',results (return-all ,query)
diff -r 8cfac0fbe30d -r 5c914fbcb042 test/run.lisp
--- a/test/run.lisp	Wed Jul 13 23:36:51 2016 +0000
+++ b/test/run.lisp	Thu Jul 14 13:30:57 2016 +0000
@@ -1,24 +1,19 @@
+#+ecl (setf compiler:*user-cc-flags* "-Wno-shift-negative-value")
+
 (declaim (optimize (debug 3) (safety 3) (speed 0)))
 
+
 (let ((*standard-output* (make-broadcast-stream))
       (*error-output* (make-broadcast-stream)))
   (asdf:load-system 'bones :force t)
   (ql:quickload "bones-test"))
 
-
-(defvar *passed* t)
-
-(defun test (spec)
-  (let ((result (5am:run spec)))
-    (5am:explain! result)
-    (when (not (5am:results-status result))
-      (setf *passed* nil))))
+(defun done (exit-code)
+  #+sbcl (sb-ext:exit :code exit-code)
+  #+ccl (quit exit-code)
+  #+ecl (quit exit-code))
 
-(test :bones)
-(test :bones.paip)
-(test :bones.wam)
-(test :bones.circle)
 
-(let ((exit-code (if *passed* 0 1)))
-  #+sbcl (sb-ext:exit :code exit-code)
-  #+ccl (quit exit-code))
+(time (progn (1am:run) (terpri)))
+(terpri)
+(done 0)
diff -r 8cfac0fbe30d -r 5c914fbcb042 test/wam.lisp
--- a/test/wam.lisp	Wed Jul 13 23:36:51 2016 +0000
+++ b/test/wam.lisp	Thu Jul 14 13:30:57 2016 +0000
@@ -1,9 +1,5 @@
 (in-package #:bones-test.wam)
 
-(def-suite :bones.wam)
-(in-suite :bones.wam)
-
-
 ;;;; Setup
 (defun make-test-database ()
   (let ((db (make-database)))
@@ -166,7 +162,7 @@
        (?x cats)
        (?x (f dogs))))))
 
-(test not
+(test negation
   (with-fresh-database
     (push-logic-frame-with
       (fact (yes ?anything))