Commits

Anonymous committed 593ca1d

Added the beginning of the CL-TAP. Not working.

Comments (0)

Files changed (4)

nurikabe-solver/Makefile

+all:
+
+test:
+	runprove t/*.t

nurikabe-solver/cl-tap.lisp

+;;; A Lisp implementation of TAP, the Test-Anything-Protocol:
+;;;
+;;; http://testanything.org/
+;;;
+;;; Very ad-hoc so far.
+;;; 
+;;; This code is distributed under the MIT/X11 license:
+;;; 
+;;; http://www.opensource.org/licenses/mit-license.php
+;;;
+;;; Copyright by Shlomi Fish, 2008
+
+(defclass tester ()
+  ((num-planned
+    :reader num-planned
+    :writer (setf num-planned))
+   (curr-test
+     :initform 0
+     :reader curr-test
+     :writer (setf curr-test))))
+
+(defmethod ok ((self tester) value &optional msg)
+  (format t "~a" (if value "ok" "not ok"))
+  (format t "~a" " ")
+  (incf (curr-test self))
+  (format t (curr-test self))
+  (if msg
+    (format t "~a~a" "- " msg))
+  (format t "~%")
+  value)
+
+(defmethod plan ((self tester) num)
+  (setf (num-planned self) num)
+  (format t "1..~a~%" num))
+
+; (with (curr-test 0 num-planned 0)
+;       (def ok (value (o msg))
+;            (if value (pr "ok") (pr "not ok"))
+;            (pr " ")
+;            (pr (++ curr-test))
+;            (pr " ")
+;            (if msg (pr "- " msg))
+;            (prn)
+;            value)
+;       (def chomp (s)
+;            (let l (len s)
+;              (cut s 0 (- l (if (is (s (- l 1)) #\Newline) 1 0)))))
+;       (def diag (msg)
+;            (let lines (ssplit (chomp msg) [ is _ #\Newline ])
+;              (each l lines
+;                    (w/stdout (stderr)
+;                              (prn "# " l)))))
+;       (def plan (num)
+;            (= num-planned num)
+;            (prn "1.." num))
+;       (def swrite (v)
+;            (tostring (write v)))
+;       (def test-is (got expected (o msg))
+;            (with (verdict (ok (is got expected) msg))
+;                  (if (not verdict)
+;                      (do (diag (tostring (prn "  Failed test '" msg "'")))
+;                          (diag (+ "         got: " (swrite got)))
+;                          (diag (+ "    expected: " (swrite expected)))))
+;                  verdict))
+;       (def test-iso (got expected (o msg))
+;            (with (verdict (ok (iso got expected) msg))
+;                  (if (not verdict)
+;                      (do (diag (tostring (prn "  Failed test '" msg "'")))
+;                          (diag (+ "         got: " (swrite got)))
+;                          (diag (+ "    expected: " (swrite expected)))))
+;                  verdict))
+;       (def is-deeply (got expected (o msg))
+;            (test-iso got expected msg)))

nurikabe-solver/t/01-cl-tap-meta.pl.t

+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use Test::Trap qw( trap $trap :flow:stderr(systemsafe):stdout(systemsafe):warn );
+
+trap {
+    system(qw(sbcl --noinform --noprint --disable-debugger --load), "t/files/tap-diag1.lisp");
+};
+
+# TEST
+is ($trap->stderr(), qq{# Hi\n# There\n}, "Checking for correct diag");
+
+exit(0);
+
+trap {
+    system("bash", "arc.sh", "t/files/tap-test-is1.arc");
+};
+
+#-TEST
+is ($trap->stderr(),
+    qq{#   Failed test 'Not good'\n#          got: 5\n#     expected: 6\n},
+    "Checking for correct test-is diagnostics"
+);
+
+trap {
+    system("bash", "arc.sh", "t/files/tap-test-is2.arc");
+};
+
+#-TEST
+like ($trap->stdout(), qr{^ok 1 - 5 equals 5\n}ms,
+    "Checking that (test-is) emits the test name"
+);
+

nurikabe-solver/t/files/tap-diag1.lisp

+(load "cl-tap.lisp")
+
+(defparameter *tester* (make-instance 'tester))
+
+(plan *tester* 1)
+
+(ok *tester* nil "Message")
+(diag *tester* "Hi\nThere\n")