racket/collects/tests/drracket/get-defs-test.rkt
2011-06-28 02:01:41 -04:00

67 lines
1.7 KiB
Racket

#lang racket
(require drracket/private/get-defs
racket/gui
string-constants)
(define (get-definitions/string
string
#:define-prefix [define-prefix "(define"])
(define text (new text%))
(send text insert (make-object string-snip% string))
(get-definitions define-prefix #f text))
(define-syntax (test-definitions stx)
(syntax-case stx ()
[(_ string ((name start end) ...))
#`(let ([actual (map (match-lambda [(defn _ n s e)
(list n s e)])
(get-definitions/string string))]
[expected (list (list name start end) ...)])
(unless (equal? actual expected)
(eprintf "Test failure at ~a\nActual: ~s\nExpected: ~s\n"
#,(format "~a:~a:~a"
(syntax-source #'stx)
(syntax-line #'stx)
(syntax-column #'stx))
actual
expected)))]))
(test-definitions
#<<END
(define x 1)
(define (f x)
(define y x)
y)
(define y 2)
(define
END
(("x" 0 12)
; The end positions for f and the inner y look wrong to me.
; If they look wrong to you too (but you know what you're doing),
; please change the tests.
("f" 13 28)
("y" 29 46)
("y" 47 59)
((string-constant end-of-buffer-define) 60 67)))
(test-definitions
#<<END
(define-metafunction L
f : p -> q
[(f p) t])
(define-metafunction L
[(g p) t])
(define-metafunction/extension f L
h : p -> q
[(h p) t])
(define-metafunction/extension f L
[(i p) t])
(define-metafunction
END
(("f" 0 48)
("g" 49 84)
("h" 85 145)
("i" 146 193)
((string-constant end-of-buffer-define) 194 214)))