Add a testing framework and test org/nodes and org/cursor packages
This commit is contained in:
Renaud Casenave-Péré
parent
089e70eca8
commit
7a80b4ea1e
3 changed files with 282 additions and 6 deletions
|
|
@ -3,13 +3,14 @@
|
|||
(:export #:org-print))
|
||||
(in-package :sextant/org/printer)
|
||||
|
||||
(defgeneric org-print (node stream))
|
||||
(defgeneric org-print (node stream &optional only-visible-p))
|
||||
|
||||
(defmethod org-print ((node org-document) stream)
|
||||
(defmethod org-print ((node org-document) stream &optional (only-visible-p nil))
|
||||
(loop for c = (next-of node) then (next-of c)
|
||||
while c
|
||||
do (org-print c stream)))
|
||||
do (org-print c stream only-visible-p)))
|
||||
|
||||
(defmethod org-print ((node org-line) stream)
|
||||
(princ (raw-text-of node) stream)
|
||||
(princ (line-ending-of node) stream))
|
||||
(defmethod org-print ((node org-line) stream &optional (only-visible-p nil))
|
||||
(when (or (node-visible-p node) (not only-visible-p))
|
||||
(princ (raw-text-of node) stream)
|
||||
(princ (line-ending-of node) stream)))
|
||||
|
|
|
|||
|
|
@ -29,6 +29,8 @@ int main(int argc, char** argv)
|
|||
code += "(si:top-level)";
|
||||
}
|
||||
else {
|
||||
if (args.contains("-tests"))
|
||||
code += "(load \"tests.lisp\")";
|
||||
if (args.contains("-make"))
|
||||
code += "(load \"make.lisp\")";
|
||||
}
|
||||
|
|
|
|||
273
tests.lisp
Normal file
273
tests.lisp
Normal file
|
|
@ -0,0 +1,273 @@
|
|||
#-eql5
|
||||
(error "Please use the EQL5 executable")
|
||||
|
||||
(require 'ecl-quicklisp)
|
||||
(ql:quickload :fiveam)
|
||||
|
||||
(use-package :alexandria)
|
||||
(use-package :fiveam)
|
||||
(use-package :org)
|
||||
|
||||
(defmacro with-open-org-from-string (str &body body)
|
||||
`(progn
|
||||
(open-from-string ,str)
|
||||
,@body))
|
||||
|
||||
(defmacro with-open-org-file (pathname &body body)
|
||||
`(progn
|
||||
(open-file ,pathname)
|
||||
,@body
|
||||
(close-file)))
|
||||
|
||||
(defparameter empty-org "")
|
||||
|
||||
(defparameter test-org-1 "preamble 1
|
||||
preamble 2
|
||||
* header 1
|
||||
line 1
|
||||
line 2
|
||||
** header 2
|
||||
line 3
|
||||
line 4
|
||||
* header 3
|
||||
line 5
|
||||
")
|
||||
|
||||
(defmacro with-test-org-1 (&body body)
|
||||
`(let* ((test-org (sextant:make-document-from-string test-org-1))
|
||||
(preamble-1 (next-of test-org))
|
||||
(preamble-2 (next-of preamble-1))
|
||||
(header-1 (next-of preamble-2))
|
||||
(line-1 (next-of header-1))
|
||||
(line-2 (next-of line-1))
|
||||
(header-2 (next-of line-2))
|
||||
(line-3 (next-of header-2))
|
||||
(line-4 (next-of line-3))
|
||||
(header-3 (next-of line-4))
|
||||
(line-5 (next-of header-3)))
|
||||
,@body))
|
||||
|
||||
|
||||
(defparameter test-org-2 "* header 1
|
||||
** sub header 1
|
||||
*** sub sub header 1
|
||||
** sub header 2
|
||||
**** sub sub sub header 1
|
||||
*** sub sub header 2
|
||||
")
|
||||
|
||||
(defmacro with-test-org-2 (&body body)
|
||||
`(let* ((test-org (sextant:make-document-from-string test-org-2))
|
||||
(first-node (next-of test-org))
|
||||
(second-node (next-of first-node))
|
||||
(third-node (next-of second-node))
|
||||
(fourth-node (next-of third-node))
|
||||
(fifth-node (next-of fourth-node))
|
||||
(sixth-node (next-of fifth-node)))
|
||||
,@body))
|
||||
|
||||
(def-suite all-tests)
|
||||
|
||||
(def-suite org :in all-tests)
|
||||
(in-suite org)
|
||||
|
||||
(test parse-document
|
||||
(is (equal "" (raw-text-of (next-of (sextant:make-document-from-string empty-org)))))
|
||||
(is (null (next-of (next-of (sextant:make-document-from-string empty-org)))))
|
||||
(let ((test-org (sextant:make-document-from-string test-org-1)))
|
||||
(is (= 10 (loop for n = (next-of test-org) then (next-of n)
|
||||
until (null n)
|
||||
count n)))
|
||||
(is (= 3 (loop for h = (next-headline-of test-org) then (next-headline-of h)
|
||||
until (null h)
|
||||
count h)))
|
||||
(is (equal test-org-1 (with-output-to-string (str) (org-print test-org str)))))
|
||||
(let ((test-org (sextant:make-document-from-string test-org-2)))
|
||||
(is (= 6 (loop for n = (next-of test-org) then (next-of n)
|
||||
until (null n)
|
||||
count n)))
|
||||
(is (= 6 (loop for h = (next-headline-of test-org) then (next-headline-of h)
|
||||
until (null h)
|
||||
count h)))
|
||||
(is (equal test-org-2 (with-output-to-string (str) (org-print test-org str))))))
|
||||
|
||||
(test headline-of
|
||||
(let* ((test-org (sextant:make-document-from-string test-org-1))
|
||||
(current-node (next-of test-org)))
|
||||
(is (null (headline-of current-node)))
|
||||
(let ((first-headline (next-headline-of current-node)))
|
||||
(is (equal "header 1" (title-of first-headline)))
|
||||
(is (null (headline-of first-headline)))
|
||||
(setf current-node (next-of first-headline))
|
||||
(is (eq first-headline (headline-of current-node)))
|
||||
(is (eq (next-headline-of first-headline) (next-headline-of current-node))))))
|
||||
|
||||
(test depth-of
|
||||
(let* ((test-org (sextant:make-document-from-string test-org-1))
|
||||
(first-node (next-of test-org)))
|
||||
(is (= 0 (depth-of first-node)))
|
||||
(let* ((first-headline (next-headline-of first-node))
|
||||
(line-1 (next-of first-headline)))
|
||||
(is (= 0 (depth-of first-headline)))
|
||||
(is (= 1 (depth-of line-1))))))
|
||||
|
||||
(test path-of
|
||||
(with-test-org-2
|
||||
(is (equal (list first-node) (path-of first-node)))
|
||||
(is (equal (list first-node second-node) (path-of second-node)))
|
||||
(is (equal (list first-node second-node third-node) (path-of third-node)))
|
||||
(is (equal (list first-node fourth-node fifth-node) (path-of fifth-node)))))
|
||||
|
||||
(test count-nodes
|
||||
(with-test-org-1
|
||||
(is (= 0 (count-nodes line-2 line-2)))
|
||||
(is (= 1 (count-nodes preamble-1 preamble-2)))
|
||||
(is (= 3 (count-nodes header-2 header-3)))
|
||||
(is (= 9 (count-nodes preamble-1 line-5)))
|
||||
(is (null (count-nodes line-4 line-1)))))
|
||||
|
||||
(test visibility
|
||||
(with-test-org-1
|
||||
(setf (property-of header-2 :visibility) :collapsed)
|
||||
(is (equal "preamble 1
|
||||
preamble 2
|
||||
* header 1
|
||||
line 1
|
||||
line 2
|
||||
** header 2
|
||||
* header 3
|
||||
line 5
|
||||
" (with-output-to-string (str) (org-print test-org str t))))
|
||||
(setf (property-of header-1 :visibility) :collapsed)
|
||||
(is (null (node-visible-p line-1)))
|
||||
(is (equal "preamble 1
|
||||
preamble 2
|
||||
* header 1
|
||||
* header 3
|
||||
line 5
|
||||
" (with-output-to-string (str) (org-print test-org str t))))
|
||||
(setf (property-of header-2 :visibility) :expanded)
|
||||
(is (equal "preamble 1
|
||||
preamble 2
|
||||
* header 1
|
||||
line 3
|
||||
line 4
|
||||
* header 3
|
||||
line 5
|
||||
" (with-output-to-string (str) (org-print test-org str t))))
|
||||
(setf (property-of header-3 :visibility) :collapsed)
|
||||
(is (equal "preamble 1
|
||||
preamble 2
|
||||
* header 1
|
||||
line 3
|
||||
line 4
|
||||
* header 3
|
||||
" (with-output-to-string (str) (org-print test-org str t))))))
|
||||
|
||||
(def-suite cursor :in all-tests)
|
||||
(in-suite cursor)
|
||||
|
||||
(defmacro check-cursor (cursor node index visual-index)
|
||||
(once-only (cursor)
|
||||
`(progn
|
||||
(is (eq ,node (cursor-node ,cursor)))
|
||||
(is (eq ,index (cursor-index ,cursor)))
|
||||
(is (eq ,visual-index (visual-index ,cursor))))))
|
||||
|
||||
(defmacro check-visible-cursor (cursor node index visual-index)
|
||||
(once-only (cursor)
|
||||
`(progn
|
||||
(is (eq ,node (visible-node ,cursor)))
|
||||
(is (eq ,index (visible-index ,cursor)))
|
||||
(is (eq ,visual-index (visual-index ,cursor))))))
|
||||
|
||||
(test next-previous-node
|
||||
(with-test-org-1
|
||||
(let ((cursor (make-cursor preamble-1 0 0)))
|
||||
(check-cursor cursor preamble-1 0 0)
|
||||
(check-visible-cursor cursor preamble-1 0 0)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor preamble-2 1 1)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor line-1 3 3)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor line-2 4 4)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor header-2 5 5)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor line-3 6 6)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor line-4 7 7)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor header-3 8 8)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor line-5 9 9)
|
||||
(is (null (next-node cursor)))
|
||||
(dotimes (i 9)
|
||||
(setf cursor (previous-node cursor)))
|
||||
(check-visible-cursor cursor preamble-1 0 0)
|
||||
(is (null (previous-node cursor))))))
|
||||
|
||||
(test next-previous-headline
|
||||
(with-test-org-1
|
||||
(let ((cursor (make-cursor preamble-1 0 0)))
|
||||
(setf cursor (next-headline cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(setf cursor (next-headline cursor))
|
||||
(check-visible-cursor cursor header-2 5 5)
|
||||
(setf cursor (next-headline cursor))
|
||||
(check-visible-cursor cursor header-3 8 8)
|
||||
(is (null (next-headline cursor)))
|
||||
(setf cursor (previous-headline cursor))
|
||||
(check-visible-cursor cursor header-2 5 5)
|
||||
(setf cursor (previous-headline cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(is (null (previous-headline cursor))))))
|
||||
|
||||
(test next-previous-visible-node
|
||||
(with-test-org-1
|
||||
(let ((cursor (make-cursor preamble-1 0 0)))
|
||||
(setf (property-of header-2 :visibility) :collapsed)
|
||||
(setf (property-of header-1 :visibility) :collapsed)
|
||||
(setf cursor (next-node (next-node cursor)))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(setf cursor (next-visible-node cursor))
|
||||
(check-visible-cursor cursor header-3 8 3)
|
||||
(check-cursor cursor header-3 8 3)
|
||||
(setf (property-of header-1 :visibility) :expanded)
|
||||
(setf cursor (previous-visible-node cursor))
|
||||
(check-visible-cursor cursor header-2 5 2)
|
||||
(check-cursor cursor header-2 5 2)
|
||||
(setf cursor (previous-visible-node cursor))
|
||||
(check-visible-cursor cursor line-2 4 1))))
|
||||
|
||||
(test next-previous-hidden-node
|
||||
(with-test-org-1
|
||||
(let ((cursor (make-cursor preamble-1 0 0)))
|
||||
(setf (property-of header-2 :visibility) :collapsed)
|
||||
(setf (property-of header-1 :visibility) :collapsed)
|
||||
(setf cursor (next-node (next-node cursor)))
|
||||
(check-cursor cursor header-1 2 2)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(check-cursor cursor line-1 3 2)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(check-cursor cursor line-2 4 2)
|
||||
(setf cursor (next-node cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(check-cursor cursor header-2 5 2)
|
||||
(setf cursor (next-headline cursor))
|
||||
(check-visible-cursor cursor header-3 8 3)
|
||||
(check-cursor cursor header-3 8 3)
|
||||
(setf cursor (previous-node cursor))
|
||||
(check-visible-cursor cursor header-1 2 2)
|
||||
(check-cursor cursor line-4 7 2)
|
||||
(setf (property-of header-2 :visibility) :expanded)
|
||||
(setf cursor (previous-node cursor))
|
||||
(check-visible-cursor cursor line-3 6 1)
|
||||
(check-cursor cursor line-3 6 1))))
|
||||
|
||||
(run! 'all-tests)
|
||||
Loading…
Add table
Reference in a new issue