(module lw-test mzscheme (require "test-util.ss" "loc-wrapper.ss") (define (normalize lw) (define-values (min-line min-column) (find-min-line/col lw)) (define (normalize/lw lw) (cond [(loc-wrapper? lw) (make-loc-wrapper (normalize/e (loc-wrapper-e lw)) (- (loc-wrapper-line lw) min-line) (loc-wrapper-line-span lw) (- (loc-wrapper-column lw) min-column) (loc-wrapper-column-span lw) (loc-wrapper-unq? lw) (loc-wrapper-metafunction-name lw))] [else lw])) (define (normalize/e e) (cond [(symbol? e) e] [(string? e) e] [else (map normalize/lw e)])) (normalize/lw lw)) (define (find-min-line/col lw) (define min-line #f) (define min-col #f) (define (find-min/lw lw) (when (loc-wrapper? lw) (set! min-line (if min-line (min min-line (loc-wrapper-line lw)) (loc-wrapper-line lw))) (set! min-col (if min-col (min min-col (loc-wrapper-column lw)) (loc-wrapper-column lw))) (find-min/e (loc-wrapper-e lw)))) (define (find-min/e e) (cond [(symbol? e) (void)] [(string? e) (void)] [else (for-each find-min/lw e)])) (find-min/lw lw) (values min-line min-col)) (reset-count) (test (normalize (to-loc-wrapper ())) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper ")" 0 0 1 1)) 0 0 0 2)) (test (normalize (to-loc-wrapper/uq ())) (make-loc-wrapper (list (make-loc-wrapper "(" 0 0 0 1 #t #f) (make-loc-wrapper ")" 0 0 1 1 #t #f)) 0 0 0 2 #t #f)) (test (normalize (to-loc-wrapper (a))) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper 'a 0 0 1 1) (build-loc-wrapper ")" 0 0 2 1)) 0 0 0 3)) (test (normalize (to-loc-wrapper (a b))) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper 'a 0 0 1 1) (build-loc-wrapper 'b 1 0 1 1) (build-loc-wrapper ")" 1 0 2 1)) 0 1 0 3)) (test (normalize (to-loc-wrapper (a (b c) d))) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper 'a 0 0 1 1) (build-loc-wrapper (list (build-loc-wrapper "(" 1 0 1 1) (build-loc-wrapper 'b 1 0 2 1) (build-loc-wrapper 'c 1 0 4 1) (build-loc-wrapper ")" 1 0 5 1)) 1 0 1 5) (build-loc-wrapper 'd 2 0 1 1) (build-loc-wrapper ")" 2 0 2 1)) 0 2 0 3)) (test (normalize (to-loc-wrapper (abcdefghijkl b))) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper 'abcdefghijkl 0 0 1 12) (build-loc-wrapper 'b 1 0 1 1) (build-loc-wrapper ")" 1 0 2 1)) 0 1 0 3)) (test (normalize (to-loc-wrapper ((a b) c))) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 1 1) (build-loc-wrapper 'a 0 0 2 1) (build-loc-wrapper 'b 0 0 4 1) (build-loc-wrapper ")" 0 0 5 1)) 0 0 1 5) (build-loc-wrapper 'c 1 0 1 1) (build-loc-wrapper ")" 1 0 2 1)) 0 1 0 3)) (test (normalize (to-loc-wrapper ([{}]))) (build-loc-wrapper (list (build-loc-wrapper "(" 0 0 0 1) (build-loc-wrapper (list (build-loc-wrapper "[" 0 0 1 1) (build-loc-wrapper (list (build-loc-wrapper "{" 0 0 2 1) (build-loc-wrapper "}" 0 0 3 1)) 0 0 2 2) (build-loc-wrapper "]" 0 0 4 1)) 0 0 1 4) (build-loc-wrapper ")" 0 0 5 1)) 0 0 0 6)) (test (normalize (to-loc-wrapper ,x)) (make-loc-wrapper (list (make-loc-wrapper "" 0 0 0 0 #f #f) 'spring (make-loc-wrapper 'x 0 0 1 1 #t #f)) 0 0 0 2 #f #f)) (test (normalize (to-loc-wrapper ,@x)) (make-loc-wrapper (list (make-loc-wrapper "" 0 0 0 0 #f #f) 'spring (make-loc-wrapper 'x 0 0 2 1 #t #f)) 0 0 0 3 #f #f)) (test (normalize (to-loc-wrapper 'x)) (make-loc-wrapper (list (make-loc-wrapper "" 0 0 0 0 #f #f) 'spring (make-loc-wrapper 'x 0 0 1 1 #f #f)) 0 0 0 2 #f #f)) (test (normalize (to-loc-wrapper ,(term x))) (make-loc-wrapper (list (make-loc-wrapper "" 0 0 0 0 #f #f) 'spring (make-loc-wrapper (list (make-loc-wrapper "" 0 0 1 0 #t #f) 'spring (make-loc-wrapper 'x 0 0 7 1 #f #f) 'spring) 0 0 1 7 #t #f)) 0 0 0 8 #f #f)) (printf "lw-test.ss: all ~a tests passed.\n" tests))