diff --git a/brmsaptool.scm b/brmsaptool.scm index b4aba94..8727c8b 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -20,13 +20,30 @@ ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ;; -(import (chicken process-context) +(import (chicken condition) + (chicken process-context) (chicken file) (chicken file posix)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Testing +(define-syntax with-handler + (syntax-rules () + ((_ handler body ...) + (call-with-current-continuation + (lambda (k) + (with-exception-handler + (lambda (x) (k (handler x))) + (lambda () body ...))))))) + +(define-syntax unit-test + (syntax-rules () + ((_ name condition) + (if (with-handler (lambda (x) #f) + (lambda () condition)) + (display ".") + (error 'unit-test name))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Dictionary @@ -38,15 +55,52 @@ (if (assq k d) #t #f)) (define (dict-ref d k . r) - (let ((p (assq d k)) - (d (if (null? r) #f (car r)))) + (let ((p (assq k d))) (if p (cdr p) - d))) + (if (null? r) + (error 'dict-ref "Key does not exist" k) + (car r))))) + +(define (dict-remove d k) + (let loop ((s d) + (r '()) + (e #t)) + (if (null? s) + (if e + (error 'dict-remove "Key does not exist" k) + r) + (if (eq? (caar s) k) + (loop (cdr s) r #f) + (loop (cdr s) (cons (car s) r) e))))) + +(define (dict-set d k v) + (let ((dr (let loop ((s d) + (r '())) + (if (null? s) + r + (if (eq? (caar s) k) + (loop (cdr s) r) + (loop (cdr s) (cons (car s) r))))))) + (cons (cons k v) + dr))) + +(define (dict-keys d) + (map car d)) (define (dict-tests!) (display "[test] dict ") - (newline)) + (unit-test 'make-dict (null? (make-dict))) + (unit-test 'dict-ref-nonexistent (with-handler (lambda (x) #t) (dict-ref (make-dict) 'nonexistent) #f)) + (unit-test 'dict-ref-default (dict-ref (make-dict) 'nonexistent #t)) + (unit-test 'dict-set-nonexistent (equal? (dict-set (make-dict) 'nonexistent 1) '((nonexistent . 1)))) + (unit-test 'dict-set-existent (equal? (dict-set (dict-set (make-dict) 'existent 1) 'existent 2) '((existent . 2)))) + (unit-test 'dict-remove-nonexistent (with-handler (lambda (x) #t) (dict-remove (make-dict) 'nonexistent) #f)) + (unit-test 'dict-remove-existing (null? (dict-remove (dict-set (make-dict) 'existing 1) 'existing))) + (unit-test 'dict-keys (equal? (dict-keys (dict-set (make-dict) 'existing 1)) '(existing))) + (print " ok.")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define *members-directory* "members") @@ -58,7 +112,17 @@ (directory *members-directory*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Run everything +;; Print banner +(print "brmsaptool 0.1 (c) 2023 Brmlab, z.s.") +(newline) + +;; Run tests +(print "Running self-tests:") (dict-tests!) +(print "All self-tests ok!") +(newline) +;; Perform requested action (displayln (load-members))