diff options
| -rw-r--r-- | csc/compare-test.csc | 40 | ||||
| -rw-r--r-- | csc/compare.csc | 38 | ||||
| -rw-r--r-- | csc/hash-map-test.csc | 65 |
3 files changed, 84 insertions, 59 deletions
diff --git a/csc/compare-test.csc b/csc/compare-test.csc index 8791e1d..379f21b 100644 --- a/csc/compare-test.csc +++ b/csc/compare-test.csc @@ -2,14 +2,15 @@ (only (csc match) define-match-record-type) (only (csc testing) - assert-equal + assert test) (csc compare)) (test diff-list - (assert-equal - " ( + (assert + (string=? + " ( 1 - 2 3 @@ -17,7 +18,7 @@ 4 ) " - (diff '(1 2 3 4) '(1 3 3.5 4)))) + (diff '(1 2 3 4) '(1 3 3.5 4))))) (define-match-record-type <test-type> @@ -29,8 +30,9 @@ (test diff-record - (assert-equal - " ( + (assert + (string=? + " ( (!type . <test-type> ) @@ -43,12 +45,13 @@ ) ) " - (diff (make-test-type 5 5) (make-test-type 5 6) (cons test-type? %test-type)))) + (diff (make-test-type 5 5) (make-test-type 5 6) (cons test-type? %test-type))))) (test diff-multiline-string - (assert-equal - " ( + (assert + (string=? + " ( (!type . string ) @@ -61,12 +64,13 @@ ) ) " - (diff "line-one\nline-two\nline-three" "line-one\nline-three"))) + (diff "line-one\nline-two\nline-three" "line-one\nline-three")))) (test diff-vector - (assert-equal - " ( + (assert + (string=? + " ( (!type . vector ) @@ -79,4 +83,14 @@ ) ) " - (diff #(1 2 3) #(1 3)))) + (diff #(1 2 3) #(1 3))))) + + +(test diff-symbol-list + (assert + (string=? + "- symbol ++ ( ++ ) +" + (diff 'symbol '())))) diff --git a/csc/compare.csc b/csc/compare.csc index dea2366..794d795 100644 --- a/csc/compare.csc +++ b/csc/compare.csc @@ -5,8 +5,6 @@ (only (csc loop) loop return) - (only (csc match) match) - (only (csc sort) sort) (only (csc strings) contains split) @@ -28,20 +26,24 @@ (define (alist? l) - (match l - (((key . _) . _) - (symbol? key)) - (_ #f))) + (and (list? l) + (loop for x in l + unless (and (pair? x) + (symbol? (car x))) + return #f + finally (return #t)))) (define (transform x transformers) (define x* (apply-transformer transformers x)) (cond ((alist? x*) - (sort (lambda (a b) (string<? (symbol->string (car a)) (symbol->string (car b)))) - (map (lambda (elem) - (cons (car elem) (transform (cdr elem) transformers))) - x*))) + (map (lambda (elem) + (define elem* (apply-transformer transformers elem)) + (if (pair? elem*) + (cons (car elem) (transform (cdr elem) transformers)) + elem*)) + x*)) ((list? x*) (map (lambda (elem) (transform elem transformers)) x*)) @@ -76,17 +78,17 @@ (define (pretty w x indent) (cond - ((and (pair? x) - (symbol? (car x))) - (fprintf w "{} ({} .\n" indent (car x)) - (pretty w (cdr x) (string-append indent " ")) - (fprintf w "{} )\n" indent)) ((list? x) (fprintf w "{} (\n" indent) (loop with new-indent = (string-append indent " ") for v in x do (pretty w v new-indent)) (fprintf w "{} )\n" indent)) + ((and (pair? x) + (symbol? (car x))) + (fprintf w "{} ({} .\n" indent (car x)) + (pretty w (cdr x) (string-append indent " ")) + (fprintf w "{} )\n" indent)) (else (fprintf w "{} {}\n" indent x)))) @@ -182,7 +184,11 @@ (set! y (cdr y)) (set! equal #f)) (fprintf w "{} )\n" indent) - equal)))) + equal)) + (else + (pretty w x (string-append indent "-")) + (pretty w y (string-append indent "+")) + #f))) (define default-transformers diff --git a/csc/hash-map-test.csc b/csc/hash-map-test.csc index da58e69..10edc26 100644 --- a/csc/hash-map-test.csc +++ b/csc/hash-map-test.csc @@ -12,82 +12,87 @@ (csc hash-map)) -(define (alist->map->alist l) - (map->alist (alist->map compare-symbols l))) +(define transform-map + (list + (cons map? map->alist) + (cons list? (lambda (l) (sort (lambda (x y) (string<? (symbol->string (car x)) (symbol->string (car y)))) l))))) -(test map->alist-singleton +(test alist->map-singleton (assert-equal '((a . 1)) - (alist->map->alist '((a . 1))))) + (alist->map compare-symbols '((a . 1))) + transform-map)) -(test map->alist-two +(test alist->map-two (assert-equal '((a . 1) (b . 2)) - (alist->map->alist '((a . 1) (b . 2)))) + (alist->map compare-symbols '((a . 1) (b . 2))) + transform-map)) -(test map->alist-longer +(test alist->map-longer (assert-equal '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6)) - (alist->map->alist '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6)))))) + (alist->map compare-symbols '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))) + transform-map)) -(test map->alist-larger +(test alist->map-larger (assert-equal '((f . 5) (m . 1) (n . 7) (q . 3) (x . 8)) - (alist->map->alist '((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))))) + (alist->map compare-symbols '((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))) + transform-map)) -(test map->alist-in-order +(test alist->map-in-order (assert-equal '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())) - (alist->map->alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))))) + (alist->map compare-symbols '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))) + transform-map)) -(test map->alist-reversed +(test alist->map-reversed (assert-equal '((h . ()) (g . ()) (f . ()) (e . ()) (d . ()) (c . ()) (b . ()) (a . ())) - (alist->map->alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))))) + (alist->map compare-symbols '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))) + transform-map)) -(test map->alist-overwrite +(test alist->map-overwrite (assert-equal '((a . 2)) - (alist->map->alist '((a . 1) (a . 2))))) + (alist->map compare-symbols '((a . 1) (a . 2))) + transform-map)) -(test map->alist-alternating +(test alist->map-alternating (assert-equal '((h . ()) (g . ()) (i . ()) (f . ()) (j . ()) (e . ()) (k . ()) (d . ()) (l . ()) (c . ())) - (alist->map->alist '((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))))) + (alist->map compare-symbols '((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))) + transform-map)) + + +(define (test-map . bindings) + (alist->map compare-symbols bindings)) (test lookup (assert-equal 2 - (lookup (alist->map compare-symbols '((a . 1) (b . 2) (c . 3))) 'b))) + (lookup (test-map '(a . 1) '(b . 2) '(c . 3)) 'b))) (test lookup-notfound (assert-raises key-not-found-error? - (lookup (alist->map compare-symbols '((a . 1) (b . 2) (c . 3))) 'd))) + (lookup (test-map '(a . 1) '(b . 2) '(c . 3)) 'd))) (test lookup-default (assert-equal #f - (lookup (alist->map compare-symbols '((a . #t) (b . #t))) 'c #f))) - - -(define transform-map - (list - (cons map? map->alist))) - - -(define (test-map . bindings) - (alist->map compare-symbols bindings)) + (lookup (test-map '(a . #t) '(b . #t)) 'c #f))) (test merge |