2024-08-22 20:05:49 -04:00
|
|
|
;;; Copyright (C) Peter McGoron 2024
|
|
|
|
;;; 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, version 3 of the License.
|
|
|
|
;;;
|
|
|
|
;;; 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, see <https://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
;;; Test harness.
|
|
|
|
;;; Each test is a name and a function with no arguments. The function
|
|
|
|
;;; returns #t for success, #f for undefined failure, and a string for
|
|
|
|
;;; known failure.
|
|
|
|
;;;
|
|
|
|
;;; TODO: Return test results as a list.
|
|
|
|
|
2024-09-04 02:16:10 -04:00
|
|
|
(load "util.scm")
|
|
|
|
|
2024-08-22 20:05:49 -04:00
|
|
|
(define verbose? #t)
|
|
|
|
|
|
|
|
(define run-tests
|
|
|
|
(lambda (tests)
|
|
|
|
(letrec
|
|
|
|
((run-test
|
|
|
|
(lambda (name test)
|
|
|
|
(if verbose?
|
|
|
|
(begin
|
|
|
|
(display "running: ")
|
|
|
|
(display name)
|
|
|
|
(newline))
|
|
|
|
#f)
|
|
|
|
(let ((result (test)))
|
|
|
|
(if (not result)
|
|
|
|
"undefined failure"
|
|
|
|
result))))
|
|
|
|
(loop
|
|
|
|
(lambda (rest)
|
|
|
|
(if (null? rest)
|
|
|
|
#t
|
|
|
|
(let ((descr (car rest)))
|
|
|
|
(let ((return (run-test
|
|
|
|
(car descr)
|
|
|
|
(cdr descr))))
|
|
|
|
(if (not (eq? return #t))
|
|
|
|
return
|
|
|
|
(loop (cdr rest)))))))))
|
|
|
|
(loop tests))))
|
|
|
|
|
2024-08-29 22:24:33 -04:00
|
|
|
(define report-tests
|
|
|
|
(lambda (tests)
|
|
|
|
(let ((res (run-tests tests)))
|
|
|
|
(if (eq? res #t)
|
|
|
|
(display "passed")
|
|
|
|
(begin
|
|
|
|
(display "failed: ")
|
|
|
|
(display res))))
|
|
|
|
(newline)))
|
|
|
|
|
2024-08-22 20:05:49 -04:00
|
|
|
(load "doubly-linked-list.scm")
|
2024-08-29 22:24:33 -04:00
|
|
|
(display "running doubly linked list tests: ")
|
2024-08-22 20:05:49 -04:00
|
|
|
(newline)
|
2024-08-29 22:24:33 -04:00
|
|
|
(report-tests %dl:tests)
|
|
|
|
|
|
|
|
(load "set.scm")
|
|
|
|
(display "running string BST-AVL tests")
|
2024-08-22 20:05:49 -04:00
|
|
|
(newline)
|
2024-08-29 22:24:33 -04:00
|
|
|
(report-tests %set:tests)
|
2024-09-04 02:16:10 -04:00
|
|
|
|
|
|
|
(load "trie.scm")
|
|
|
|
(display "char trie")
|
|
|
|
(newline)
|
|
|
|
(report-tests %trie:tests)
|