330 lines
11 KiB
Racket
330 lines
11 KiB
Racket
#|
|
|
|
|
DO NOT TABIFY THIS FILE
|
|
|
|
|#
|
|
|
|
|
|
;
|
|
;
|
|
; ;;;;
|
|
; ; ; ;
|
|
; ; ; ;;; ;; ;; ;;; ;;;;;
|
|
; ; ; ; ; ;; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ;
|
|
; ;;;; ;;; ;;; ;;; ;;; ;;;
|
|
;
|
|
;
|
|
;
|
|
;
|
|
;
|
|
;
|
|
; ;; ; ;;;
|
|
; ; ; ;
|
|
; ;;;;; ;;; ; ;; ;;; ;;;;; ;;; ;;;
|
|
; ; ; ; ;; ; ; ; ; ;
|
|
; ; ;;;; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ;;
|
|
; ;;; ;;;;;;;;;; ;;;;; ;;;;; ;
|
|
; ;
|
|
; ;;;;
|
|
;
|
|
;
|
|
;
|
|
;
|
|
; ;; ; ;;; ; ;;
|
|
; ; ; ; ;
|
|
; ;;;;; ; ;; ;;; ;;;; ;;;;; ;;; ; ;;;
|
|
; ; ;; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ;;; ; ; ; ;;;;;
|
|
; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ;;; ;;; ;;; ;;;;; ;;;; ;;;;; ;;;;; ;;;;; ;;;;
|
|
;
|
|
;
|
|
;
|
|
;
|
|
|
|
|
|
(module lw-test racket/base
|
|
(require "test-util.rkt"
|
|
"../private/loc-wrapper.rkt"
|
|
"lw-test-util.rkt"
|
|
(only-in "../pict.rkt" to-lw/stx))
|
|
|
|
(reset-count)
|
|
|
|
(test (normalize-lw (to-lw ()))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw ")" 0 0 1 1))
|
|
0 0 0 2))
|
|
|
|
(test (normalize-lw (to-lw "x"))
|
|
(build-lw "“x”" 0 0 0 3))
|
|
|
|
(test (normalize-lw (to-lw "#f"))
|
|
(build-lw "“#f”" 0 0 0 4))
|
|
|
|
(test (normalize-lw (to-lw #f))
|
|
(build-lw "#f" 0 0 0 2))
|
|
|
|
(test (normalize-lw (to-lw/uq ()))
|
|
(make-lw (list (make-lw "(" 0 0 0 1 #t #f)
|
|
(make-lw ")" 0 0 1 1 #t #f))
|
|
0 0 0 2 #t #f))
|
|
|
|
(test (normalize-lw (to-lw (a)))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'a 0 0 1 1)
|
|
(build-lw ")" 0 0 2 1))
|
|
0 0 0 3))
|
|
|
|
(test (normalize-lw (to-lw (a
|
|
b)))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'a 0 0 1 1)
|
|
(build-lw 'b 1 0 1 1)
|
|
(build-lw ")" 1 0 2 1))
|
|
0 1 0 3))
|
|
|
|
(test (normalize-lw (to-lw (a b)))
|
|
(build-lw
|
|
(list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'a 0 0 1 1)
|
|
(build-lw 'b 0 0 3 1)
|
|
(build-lw ")" 0 0 4 1))
|
|
0 0 0 5))
|
|
|
|
|
|
(test (normalize-lw (to-lw (a
|
|
(b c)
|
|
d)))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'a 0 0 1 1)
|
|
(build-lw
|
|
(list (build-lw "(" 1 0 1 1)
|
|
(build-lw 'b 1 0 2 1)
|
|
(build-lw 'c 1 0 4 1)
|
|
(build-lw ")" 1 0 5 1))
|
|
1 0 1 5)
|
|
(build-lw 'd 2 0 1 1)
|
|
(build-lw ")" 2 0 2 1))
|
|
0 2 0 3))
|
|
|
|
(test (normalize-lw (to-lw (abcdefghijkl
|
|
b)))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'abcdefghijkl 0 0 1 12)
|
|
(build-lw 'b 1 0 1 1)
|
|
(build-lw ")" 1 0 2 1))
|
|
0 1 0 3))
|
|
|
|
(test (normalize-lw (to-lw ((a b)
|
|
c)))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw
|
|
(list (build-lw "(" 0 0 1 1)
|
|
(build-lw 'a 0 0 2 1)
|
|
(build-lw 'b 0 0 4 1)
|
|
(build-lw ")" 0 0 5 1))
|
|
0 0 1 5)
|
|
(build-lw 'c 1 0 1 1)
|
|
(build-lw ")" 1 0 2 1))
|
|
0 1 0 3))
|
|
|
|
(test (normalize-lw (to-lw (aaa bbb
|
|
(ccc
|
|
ddd)))) ;; <--- the ddd should be lined up under the aaa
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'aaa 0 0 1 3)
|
|
(build-lw 'bbb 0 0 5 3)
|
|
(build-lw
|
|
(list
|
|
(build-lw "(" 1 0 5 1)
|
|
(build-lw 'ccc 1 0 6 3)
|
|
(build-lw 'ddd 2 0 1 3)
|
|
(build-lw ")" 2 0 4 1))
|
|
1 1 1 4)
|
|
(build-lw ")" 2 0 5 1))
|
|
0 2 0 6))
|
|
|
|
(test (normalize-lw (to-lw (aaa bbb
|
|
(ccc
|
|
ddd ;; <--- the ddd should be lined up under the aaa
|
|
eee)))) ;; <--- the eee should be lined up under the ccc
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw 'aaa 0 0 1 3)
|
|
(build-lw 'bbb 0 0 5 3)
|
|
(build-lw
|
|
(list
|
|
(build-lw "(" 1 0 5 1)
|
|
(build-lw 'ccc 1 0 6 3)
|
|
(build-lw 'ddd 2 0 1 3)
|
|
(build-lw 'eee 3 0 6 3)
|
|
(build-lw ")" 3 0 9 1))
|
|
1 2 1 9)
|
|
(build-lw ")" 3 0 10 1))
|
|
0 3 0 11))
|
|
|
|
(test (normalize-lw (to-lw ([{}])))
|
|
(build-lw (list (build-lw "(" 0 0 0 1)
|
|
(build-lw
|
|
(list
|
|
(build-lw "[" 0 0 1 1)
|
|
(build-lw
|
|
(list
|
|
(build-lw "{" 0 0 2 1)
|
|
(build-lw "}" 0 0 3 1))
|
|
0 0 2 2)
|
|
(build-lw "]" 0 0 4 1))
|
|
0 0 1 4)
|
|
(build-lw ")" 0 0 5 1))
|
|
0 0 0 6))
|
|
|
|
(test (normalize-lw (to-lw ,x))
|
|
(make-lw
|
|
(list
|
|
(make-lw "" 0 0 0 0 #f #f)
|
|
'spring
|
|
(make-lw 'x 0 0 1 1 #t #f))
|
|
0 0 0 2 #f #f))
|
|
|
|
(test (normalize-lw (to-lw ,@x))
|
|
(make-lw
|
|
(list
|
|
(make-lw "" 0 0 0 0 #f #f)
|
|
'spring
|
|
(make-lw 'x 0 0 2 1 #t #f))
|
|
0 0 0 3 #f #f))
|
|
|
|
(test (normalize-lw (to-lw 'x))
|
|
(make-lw
|
|
(list
|
|
(make-lw "'" 0 0 0 1 #f #f)
|
|
'spring
|
|
(make-lw 'x 0 0 1 1 #f #f))
|
|
0 0 0 2 #f #f))
|
|
|
|
(test (normalize-lw (to-lw ,(term x)))
|
|
(make-lw
|
|
(list
|
|
(make-lw "" 0 0 0 0 #f #f)
|
|
'spring
|
|
(make-lw
|
|
(list
|
|
(make-lw "" 0 0 1 0 #t #f)
|
|
'spring
|
|
(make-lw 'x 0 0 7 1 #f #f))
|
|
0 0 1 7 #t #f))
|
|
0 0 0 8 #f #f))
|
|
|
|
(test (normalize-lw (to-lw (term x)))
|
|
(build-lw
|
|
(list
|
|
(build-lw "(" 0 0 0 1)
|
|
(build-lw 'term 0 0 1 4)
|
|
(build-lw 'x 0 0 6 1)
|
|
(build-lw ")" 0 0 7 1))
|
|
0 0 0 8))
|
|
|
|
(test (normalize-lw (to-lw '(term x)))
|
|
(build-lw
|
|
(list
|
|
(build-lw "'" 0 0 0 1)
|
|
'spring
|
|
(build-lw
|
|
(list
|
|
(build-lw "(" 0 0 1 1)
|
|
(build-lw 'term 0 0 2 4)
|
|
(build-lw 'x 0 0 7 1)
|
|
(build-lw ")" 0 0 8 1))
|
|
0
|
|
0
|
|
1
|
|
8))
|
|
0 0 0 9))
|
|
|
|
(test (normalize-lw (to-lw ''x))
|
|
(build-lw
|
|
(list
|
|
(build-lw "'" 0 0 0 1)
|
|
'spring
|
|
(build-lw
|
|
(list
|
|
(build-lw "'" 0 0 1 1)
|
|
'spring
|
|
(build-lw 'x 0 0 2 1))
|
|
0
|
|
0
|
|
1
|
|
2))
|
|
0 0 0 3))
|
|
|
|
(test (normalize-lw (to-lw (|+1| x)))
|
|
(build-lw
|
|
(list (build-lw "(" 0 0 0 1)
|
|
(build-lw '|+1| 0 0 1 4)
|
|
(build-lw 'x 0 0 6 1)
|
|
(build-lw ")" 0 0 7 1))
|
|
0 0 0 8))
|
|
|
|
;; this one seems suspicious: why does the second comma start at 1 instead of 0?
|
|
;; rendering seems to work, however, so we'll go with it ..
|
|
(test (normalize-lw (to-lw ,,x))
|
|
(build-lw
|
|
(list
|
|
(build-lw "" 0 0 0 0)
|
|
'spring
|
|
(make-lw
|
|
(list
|
|
(make-lw "," 0 0 1 1 #t #f)
|
|
'spring
|
|
(make-lw 'x 0 0 2 1 #t #f))
|
|
0 0 1 2
|
|
#t #f))
|
|
0 0 0 3))
|
|
|
|
(let ([from-str (λ (str)
|
|
(define p (open-input-string str))
|
|
(port-count-lines! p)
|
|
(read-syntax #f p))])
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "()")))
|
|
(normalize-lw (to-lw ())))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "a")))
|
|
(normalize-lw (to-lw a)))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "(c)")))
|
|
(normalize-lw (to-lw (c))))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "((b))")))
|
|
(normalize-lw (to-lw ((b)))))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "(a b c)")))
|
|
(normalize-lw (to-lw (a b c))))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "1")))
|
|
(normalize-lw (to-lw 1)))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "(#t)")))
|
|
(normalize-lw (to-lw (#t))))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "#f")))
|
|
(normalize-lw (to-lw #f)))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "(a b)")))
|
|
(normalize-lw (to-lw (a b))))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "(a ((b)) c 1 #t)")))
|
|
(normalize-lw (to-lw (a ((b)) c 1 #t))))
|
|
|
|
(test (normalize-lw (to-lw/stx (from-str "(a b . c)")))
|
|
(normalize-lw (to-lw (a b . c)))))
|
|
|
|
(print-tests-passed "lw-test.rkt"))
|
|
|