suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add test

Browse Source 
svn: r15343
This commit is contained in:
Jon Rafkind 2009-06-30 20:55:06 +00:00
parent 5ae06f1d2c
commit 616630f862
1 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/honu/private/util.ss
View File

@ -5,8 +5,8 @@
(require syntax/stx) (require syntax/stx)
(define (delim-identifier=? a b) (define (delim-identifier=? a b)
(eq? (syntax-e a) (syntax-e b))) (eq? (syntax-e a) (syntax-e b)))
(define extract-until (define extract-until
(case-lambda (case-lambda
@ -26,6 +26,29 @@
(stx-car r))] (stx-car r))]
[else [else
(loop (stx-cdr r) (cons (stx-car r) val-stxs))]))] (loop (stx-cdr r) (cons (stx-car r) val-stxs))]))]
[(r ids) (extract-until r ids #f)]))) [(r ids) (extract-until r ids #f)]))
(define (test)
(let* ([original #'(a b c d e)]
[delimiter #'c]
[expected-before #'(a b)]
[expected-rest #'(c d e)]
[expected-delimiter #'c]
)
(let-values ([(before rest hit) (extract-until original (list delimiter))])
;; is there a better way to test equality between two syntaxes?
(when (not (and (equal? (syntax-object->datum expected-before)
(map syntax-object->datum before))
(equal? (syntax-object->datum expected-rest)
(map syntax-object->datum rest))
(equal? (syntax-object->datum expected-delimiter)
(syntax-object->datum hit))))
(printf "failure: original ~a until ~a\n" (syntax-object->datum original) (map syntax-object->datum (list delimiter)))
(printf " before expected ~a actual ~a\n" (syntax-object->datum expected-before) (map syntax-object->datum before))
(printf " rest expected ~a actual ~a\n" (syntax-object->datum expected-rest) (map syntax-object->datum rest))
(printf " delimiter expected ~a actual ~a\n" (syntax-object->datum expected-delimiter) (syntax-object->datum hit))
))))
(test)
)