suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

eval:check

Browse Source 
svn: r9136

original commit: e8be7bf3321fe160b687f8bff29e4604ff2198a2
This commit is contained in:
Matthew Flatt 2008-04-02 13:19:10 +00:00
parent 43dae63615
commit 12312db8d8
1 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
collects/scribble/eval.ss
View File

@ -132,22 +132,32 @@
[else (loop ((car ops) s) (cdr ops))]))) [else (loop ((car ops) s) (cdr ops))])))
(define ((do-eval ev) s) (define ((do-eval ev) s)
(syntax-case s (code:comment eval:alts) (let loop ([s s][expect #f])
[(code:line v (code:comment . rest)) (syntax-case s (code:comment eval:alts eval:check)
((do-eval ev) (extract s cdr car))] [(code:line v (code:comment . rest))
[(code:comment . rest) (loop (extract s cdr car) expect)]
(list (list (void)) "" "")] [(code:comment . rest)
[(eval:alts p e) (list (list (void)) "" "")]
((do-eval ev) (extract s cdr cdr car))] [(eval:alts p e)
[else (loop (extract s cdr cdr car) expect)]
(with-handlers ([exn:fail? (lambda (e) [(eval:check e expect)
(list (exn-message e) (loop (extract s cdr car)
(get-output ev) (list (syntax->datum (datum->syntax #f (extract s cdr cdr car)))))]
(get-error-output ev)))]) [else
(list (let ([v (do-plain-eval ev s #t)]) (let ([r (with-handlers ([exn:fail? (lambda (e)
(make-reader-graph (copy-value v (make-hash-table)))) (list (exn-message e)
(get-output ev) (get-output ev)
(get-error-output ev)))])) (get-error-output ev)))])
(list (let ([v (do-plain-eval ev s #t)])
(make-reader-graph (copy-value v (make-hash-table))))
(get-output ev)
(get-error-output ev)))])
(when expect
(let ([expect (do-plain-eval ev (car expect) #t)])
(unless (equal? (car r) expect)
(raise-syntax-error 'eval "example result check failed" s))))
r)])))
(define (install ht v v2) (define (install ht v v2)
(hash-table-put! ht v v2) (hash-table-put! ht v v2)