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

adjust online check syntax to record source locations for regular

Browse Source 
runtime errors (not just syntax errors)
This commit is contained in:
Robby Findler 2014-05-31 01:53:51 -05:00
parent ddb7477494
commit eb223265f6
1 changed files with 30 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
pkgs/drracket-pkgs/drracket/drracket/private/expanding-place.rkt
View File

@ -310,6 +310,16 @@
[else ""])) [else ""]))
(format "~a~a" (srcloc-source srcloc) pos)) (format "~a~a" (srcloc-source srcloc) pos))
(define (srcloc->srcinfo a-srcloc)
(cond
[(and (srcloc? a-srcloc)
(equal? the-source (srcloc-source a-srcloc))
(srcloc-position a-srcloc)
(srcloc-span a-srcloc))
(vector (srcloc-position a-srcloc)
(srcloc-span a-srcloc))]
[else #f]))
(define exn-infos (define exn-infos
(for/list ([an-exn (in-list (cons main-exn extra-exns))]) (for/list ([an-exn (in-list (cons main-exn extra-exns))])
(exn-info (exn-info
@ -317,18 +327,26 @@
(if (exn? an-exn) (if (exn? an-exn)
(regexp-replace* #rx"[ \t]*\n[ \t]*" (exn-message an-exn) " ") (regexp-replace* #rx"[ \t]*\n[ \t]*" (exn-message an-exn) " ")
(format "uncaught exn: ~s" an-exn))) (format "uncaught exn: ~s" an-exn)))
(if (exn:srclocs? an-exn) (cond
(sort [(exn:srclocs? an-exn)
(for/list ([srcloc ((exn:srclocs-accessor an-exn) an-exn)] (sort
#:when (and (srcloc? srcloc) (for/list ([srcloc ((exn:srclocs-accessor an-exn) an-exn)]
(equal? the-source (srcloc-source srcloc)) #:when (srcloc->srcinfo srcloc))
(srcloc-position srcloc) (srcloc->srcinfo srcloc))
(srcloc-span srcloc))) <
(vector (srcloc-position srcloc) #:key (λ (x) (vector-ref x 0)))]
(srcloc-span srcloc))) [(exn? an-exn)
< (define marks (continuation-mark-set->context
#:key (λ (x) (vector-ref x 0))) (exn-continuation-marks an-exn)))
'()) (define info
(for/or ([mark-pr (in-list marks)])
(printf "considering ~s\n" mark-pr)
(srcloc->srcinfo (cdr mark-pr))))
(printf "info ~s\n" info)
(cond
[info (list info)]
[else '()])]
[else '()])
(if (exn? an-exn) (if (exn? an-exn)
(let ([ctxt (let ([ctxt
(continuation-mark-set->context (continuation-mark-set->context