improved the error reporting in the REPL and misc other minor changes
svn: r10014
This commit is contained in:
Robby Findler
parent
9777a6d079
commit
612f26972e
|
|
@ -6,19 +6,19 @@ profile todo:
|
|||
|
||||
|#
|
||||
|
||||
(module debug mzscheme
|
||||
(require mzlib/unit
|
||||
(lib "stacktrace.ss" "errortrace")
|
||||
mzlib/class
|
||||
mzlib/list
|
||||
mzlib/etc
|
||||
mzlib/file
|
||||
"drsig.ss"
|
||||
#lang scheme/base
|
||||
|
||||
(require scheme/unit
|
||||
errortrace/stacktrace
|
||||
scheme/class
|
||||
scheme/path
|
||||
framework
|
||||
mred
|
||||
scheme/gui/base
|
||||
string-constants
|
||||
(lib "bday.ss" "framework" "private")
|
||||
"bindings-browser.ss")
|
||||
framework/private/bday
|
||||
"drsig.ss"
|
||||
"bindings-browser.ss"
|
||||
(for-syntax scheme/base))
|
||||
|
||||
(define orig (current-output-port))
|
||||
|
||||
|
|
@ -87,6 +87,7 @@ profile todo:
|
|||
w-o-b
|
||||
b-o-w))))
|
||||
|
||||
(define arrow-cursor (make-object cursor% 'arrow))
|
||||
(define (clickable-snip-mixin snip%)
|
||||
(class snip%
|
||||
(init-rest args)
|
||||
|
|
@ -147,6 +148,9 @@ profile todo:
|
|||
(values (unbox wb)
|
||||
(unbox hb))))
|
||||
|
||||
(define/override (adjust-cursor dc x y editorx editory event)
|
||||
arrow-cursor)
|
||||
|
||||
(apply super-make-object args)
|
||||
(set-flags (cons 'handles-events (get-flags)))))
|
||||
|
||||
|
|
@ -180,7 +184,7 @@ profile todo:
|
|||
|
||||
(define bug-note% (make-note% "stop-multi.png" 'png/mask))
|
||||
(define mf-note% (make-note% "mf.gif" 'gif))
|
||||
(define file-note% (make-note% "stop-32x32.png" 'gif))
|
||||
(define file-note% (make-note% "stop-22x22.png" 'png/mask))
|
||||
|
||||
;; display-stats : (syntax -> syntax)
|
||||
;; count the number of syntax expressions & number of with-continuation-marks in an
|
||||
|
|
@ -214,7 +218,7 @@ profile todo:
|
|||
(let loop ([exp (if (syntax? orig-exp)
|
||||
orig-exp
|
||||
(namespace-syntax-introduce
|
||||
(datum->syntax-object #f orig-exp)))])
|
||||
(datum->syntax #f orig-exp)))])
|
||||
(let ([top-e (expand-syntax-to-top-form exp)])
|
||||
(syntax-case top-e (begin)
|
||||
[(begin expr ...)
|
||||
|
|
@ -244,29 +248,52 @@ profile todo:
|
|||
(oe annotated))])))))])
|
||||
debug-tool-eval-handler))
|
||||
|
||||
;; make-debug-error-display-handler/text : (-> (union #f (is-a?/c text%)))
|
||||
;; ((listof (list text% number number)) -> void)
|
||||
;; (string (union TST exn) -> void)
|
||||
;; -> string (union TST exn)
|
||||
;; -> void
|
||||
(define (make-debug-error-display-handler/text get-rep highlight-errors orig-error-display-handler)
|
||||
;; make-debug-error-display-handler : (string (union TST exn) -> void) -> string (union TST exn) -> void
|
||||
;; adds in the bug icon, if there are contexts to display
|
||||
(define (make-debug-error-display-handler orig-error-display-handler)
|
||||
(define (debug-error-display-handler msg exn)
|
||||
(let ([rep (get-rep)])
|
||||
(let ([rep (drscheme:rep:current-rep)])
|
||||
(cond
|
||||
[rep
|
||||
(show-error-and-highlight
|
||||
(error-display-handler/stacktrace
|
||||
msg
|
||||
exn
|
||||
(λ (srcs-to-display cms)
|
||||
(and (exn? exn)
|
||||
(continuation-mark-set? (exn-continuation-marks exn))
|
||||
(cms->srclocs (exn-continuation-marks exn))))]
|
||||
[else
|
||||
(orig-error-display-handler msg exn)])))
|
||||
debug-error-display-handler)
|
||||
|
||||
;; error-display-handler/stacktrace : string any (listof srcloc) -> void
|
||||
(define (error-display-handler/stacktrace msg exn [pre-stack #f])
|
||||
(let* ([stack (or pre-stack
|
||||
(if (exn? exn)
|
||||
(map cdr (filter cdr (continuation-mark-set->context (exn-continuation-marks exn))))
|
||||
'()))]
|
||||
[src-locs (if (exn:srclocs? exn)
|
||||
((exn:srclocs-accessor exn) exn)
|
||||
(if (null? stack)
|
||||
'()
|
||||
(list (car stack))))])
|
||||
(unless (null? stack)
|
||||
(print-bug-to-stderr msg stack))
|
||||
(display-srclocs-in-error src-locs)
|
||||
(display msg (current-error-port))
|
||||
(when (exn:fail:syntax? exn)
|
||||
(show-syntax-error-context (current-error-port) exn))
|
||||
(newline (current-error-port))
|
||||
(flush-output (current-error-port))
|
||||
(let ([rep (drscheme:rep:current-rep)])
|
||||
(when (and (is-a? rep drscheme:rep:text<%>)
|
||||
(eq? (current-error-port)
|
||||
(send rep get-err-port)))
|
||||
(parameterize ([current-eventspace drscheme:init:system-eventspace])
|
||||
(queue-callback
|
||||
(λ ()
|
||||
;; need to make sure that the user's eventspace is still the same
|
||||
;; and still running here?
|
||||
(highlight-errors rep srcs-to-display cms))))))]
|
||||
[else
|
||||
(orig-error-display-handler msg exn)])))
|
||||
debug-error-display-handler)
|
||||
(send rep highlight-errors src-locs stack))))))))
|
||||
|
||||
(define (print-bug-to-stderr msg cms)
|
||||
(when (port-writes-special? (current-error-port))
|
||||
|
|
@ -277,58 +304,58 @@ profile todo:
|
|||
(write-special note (current-error-port))
|
||||
(display #\space (current-error-port)))))))
|
||||
|
||||
(define (show-error-and-highlight msg exn highlight-errors)
|
||||
(let ([cms
|
||||
(and (exn? exn)
|
||||
(continuation-mark-set? (exn-continuation-marks exn))
|
||||
(cms->srclocs (exn-continuation-marks exn)))])
|
||||
(when (and cms
|
||||
(pair? cms))
|
||||
(print-bug-to-stderr msg cms))
|
||||
(let ([srcs-to-display (find-src-to-display exn cms)])
|
||||
(for-each display-srcloc-in-error srcs-to-display)
|
||||
(display msg (current-error-port))
|
||||
(when (exn:fail:syntax? exn)
|
||||
(show-syntax-error-context (current-error-port) exn))
|
||||
(newline (current-error-port))
|
||||
|
||||
;; need to flush here so that error annotations inserted in next line
|
||||
;; don't get erased if this output were to happen after the insertion
|
||||
(flush-output (current-error-port))
|
||||
|
||||
(highlight-errors srcs-to-display cms))))
|
||||
|
||||
;; display-srcloc-in-error : text% -> src-loc -> void
|
||||
;; display-srclocs-in-error : (listof src-loc) -> void
|
||||
;; prints out the src location information for src-to-display
|
||||
;; as it would appear in an error message
|
||||
(define (display-srcloc-in-error src-to-display)
|
||||
(let* ([raw-src (srcloc-source src-to-display)]
|
||||
[src (let ([defns-text (let ([rep (drscheme:rep:current-rep)])
|
||||
(and (is-a? rep drscheme:rep:text<%>)
|
||||
(send rep get-definitions-text)))])
|
||||
(and (not (and defns-text
|
||||
(send defns-text port-name-matches? raw-src)))
|
||||
raw-src))])
|
||||
|
||||
(when (and (path? src) file-note%)
|
||||
(define (display-srclocs-in-error srcs-to-display)
|
||||
(unless (null? srcs-to-display)
|
||||
(let ([src-to-display (car srcs-to-display)])
|
||||
(let* ([src (srcloc-source src-to-display)]
|
||||
[line (srcloc-line src-to-display)]
|
||||
[col (srcloc-column src-to-display)]
|
||||
[pos (srcloc-position src-to-display)]
|
||||
[do-icon
|
||||
(λ ()
|
||||
(when file-note%
|
||||
(when (port-writes-special? (current-error-port))
|
||||
(let ([note (new file-note%)])
|
||||
(send note set-callback
|
||||
(λ () (open-and-highlight-in-file src-to-display)))
|
||||
(λ () (open-and-highlight-in-file srcs-to-display)))
|
||||
(write-special note (current-error-port))
|
||||
(display #\space (current-error-port))))
|
||||
(display #\space (current-error-port))))))]
|
||||
[do-src
|
||||
(λ ()
|
||||
(cond
|
||||
[(path? src)
|
||||
(display (path->string (find-relative-path (current-directory)
|
||||
(normalize-path src)))
|
||||
(current-error-port))
|
||||
(let ([line (srcloc-line src-to-display)]
|
||||
[col (srcloc-column src-to-display)]
|
||||
[pos (srcloc-position src-to-display)])
|
||||
(current-error-port))]
|
||||
[else
|
||||
(display "<unsaved editor>" (current-error-port))]))]
|
||||
[do-line/col (λ () (fprintf (current-error-port) ":~a:~a" line col))]
|
||||
[do-pos (λ () (fprintf (current-error-port) "::~a" pos))]
|
||||
[src-loc-in-defs/ints?
|
||||
(let ([rep (drscheme:rep:current-rep)])
|
||||
(and rep
|
||||
(is-a? rep drscheme:rep:text<%>)
|
||||
(let ([defs (send rep get-definitions-text)])
|
||||
(or (send rep port-name-matches? src)
|
||||
(eq? rep src)
|
||||
(send defs port-name-matches? src)
|
||||
(eq? defs src)))))])
|
||||
(cond
|
||||
[(and (number? line) (number? col))
|
||||
(fprintf (current-error-port) ":~a:~a" line col)]
|
||||
[pos
|
||||
(fprintf (current-error-port) "::~a" pos)]))
|
||||
(display ": " (current-error-port)))))
|
||||
[(and src line col)
|
||||
(do-icon)
|
||||
(unless src-loc-in-defs/ints?
|
||||
(do-src)
|
||||
(do-line/col)
|
||||
(display ": " (current-error-port)))]
|
||||
[(and src pos)
|
||||
(do-icon)
|
||||
(unless src-loc-in-defs/ints?
|
||||
(do-src)
|
||||
(do-pos)
|
||||
(display ": " (current-error-port)))])))))
|
||||
|
||||
;; find-src-to-display : exn (union #f (listof srcloc))
|
||||
;; -> (listof srclocs)
|
||||
|
|
@ -350,7 +377,6 @@ profile todo:
|
|||
[(pair? cms) (list (car cms))]
|
||||
[else '()])))
|
||||
|
||||
|
||||
(define (show-syntax-error-context port exn)
|
||||
(let ([error-text-style-delta (make-object style-delta%)]
|
||||
[send-out
|
||||
|
|
@ -365,7 +391,7 @@ profile todo:
|
|||
(let ([show-one
|
||||
(λ (expr)
|
||||
(display " " (current-error-port))
|
||||
(send-out (format "~s" (syntax-object->datum expr))
|
||||
(send-out (format "~s" (syntax->datum expr))
|
||||
(λ (snp)
|
||||
(send snp set-style
|
||||
(send the-style-list find-or-create-style
|
||||
|
|
@ -381,18 +407,6 @@ profile todo:
|
|||
(show-one expr))
|
||||
exprs)]))))
|
||||
|
||||
;; make-debug-error-display-handler : (string (union TST exn) -> void) -> string (union TST exn) -> void
|
||||
;; adds in the bug icon, if there are contexts to display
|
||||
(define (make-debug-error-display-handler orig-error-display-handler)
|
||||
(make-debug-error-display-handler/text
|
||||
(λ ()
|
||||
(let ([rep (drscheme:rep:current-rep)])
|
||||
(and (is-a? rep drscheme:rep:text<%>)
|
||||
(eq? (send rep get-err-port) (current-error-port))
|
||||
rep)))
|
||||
(λ (rep errs arrows) (send rep highlight-errors errs arrows))
|
||||
orig-error-display-handler))
|
||||
|
||||
|
||||
;; insert/clickback : (instanceof text%) (union string (instanceof snip%)) (-> void)
|
||||
;; inserts `note' and a space at the end of `rep'
|
||||
|
|
@ -604,7 +618,7 @@ profile todo:
|
|||
(send text set-clickback
|
||||
start-pos end-pos
|
||||
(λ x
|
||||
(open-and-highlight-in-file (make-srcloc debug-source #f #f start span)))))
|
||||
(open-and-highlight-in-file (list (make-srcloc debug-source #f #f start span))))))
|
||||
|
||||
;; make bindings hier-list
|
||||
(let ([bindings (st-mark-bindings di)])
|
||||
|
|
@ -708,16 +722,20 @@ profile todo:
|
|||
untitled))))
|
||||
|
||||
;; open-and-highlight-in-file : srcloc -> void
|
||||
(define (open-and-highlight-in-file srcloc)
|
||||
(let* ([debug-source (srcloc-source srcloc)]
|
||||
[position (srcloc-position srcloc)]
|
||||
[span (srcloc-span srcloc)]
|
||||
(define (open-and-highlight-in-file srclocs)
|
||||
(let ([sources (filter values (map srcloc-source srclocs))])
|
||||
(unless (null? sources)
|
||||
(let* ([debug-source (car sources)]
|
||||
[same-src-srclocs
|
||||
(filter (λ (x) (eq? debug-source (srcloc-source x)))
|
||||
srclocs)]
|
||||
[frame (cond
|
||||
[(path? debug-source) (handler:edit-file debug-source)]
|
||||
[(is-a? debug-source editor<%>)
|
||||
(let ([canvas (send debug-source get-canvas)])
|
||||
(and canvas
|
||||
(send canvas get-top-level-window)))])]
|
||||
(send canvas get-top-level-window)))]
|
||||
[else #f])]
|
||||
[editor (cond
|
||||
[(path? debug-source)
|
||||
(cond
|
||||
|
|
@ -733,8 +751,8 @@ profile todo:
|
|||
(send frame show #t))
|
||||
(when (and rep editor)
|
||||
(when (is-a? editor text:basic<%>)
|
||||
(send rep highlight-error editor position (+ position span))
|
||||
(send editor set-caret-owner #f 'global)))))
|
||||
(send rep highlight-errors same-src-srclocs '())
|
||||
(send editor set-caret-owner #f 'global)))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -761,24 +779,24 @@ profile todo:
|
|||
(define current-test-coverage-info (make-thread-cell #f))
|
||||
|
||||
(define (initialize-test-coverage-point key expr)
|
||||
(unless (hash-table? (thread-cell-ref current-test-coverage-info))
|
||||
(unless (hash? (thread-cell-ref current-test-coverage-info))
|
||||
(let ([rep (drscheme:rep:current-rep)])
|
||||
(when rep
|
||||
(let ([ut (eventspace-handler-thread (send rep get-user-eventspace))])
|
||||
(when (eq? ut (current-thread))
|
||||
(let ([ht (make-hash-table)])
|
||||
(let ([ht (make-hasheq)])
|
||||
(thread-cell-set! current-test-coverage-info ht)
|
||||
(send rep set-test-coverage-info ht)))))))
|
||||
(let ([ht (thread-cell-ref current-test-coverage-info)])
|
||||
(when (hash-table? ht)
|
||||
(when (hash? ht)
|
||||
;; if rep isn't around, we don't do test coverage...
|
||||
;; this can happen when check syntax expands, for example
|
||||
(hash-table-put! ht key (mcons #f expr)))))
|
||||
(hash-set! ht key (mcons #f expr)))))
|
||||
|
||||
(define (test-covered key)
|
||||
(let ([ht (thread-cell-ref current-test-coverage-info)])
|
||||
(when (hash-table? ht) ;; as in the `when' test in `initialize-test-coverage-point'
|
||||
(let ([v (hash-table-get ht key)])
|
||||
(when (hash? ht) ;; as in the `when' test in `initialize-test-coverage-point'
|
||||
(let ([v (hash-ref ht key)])
|
||||
(set-mcar! v #t)))))
|
||||
|
||||
(define test-coverage-interactions-text<%>
|
||||
|
|
@ -800,7 +818,7 @@ profile todo:
|
|||
[test-coverage-off-style #f]
|
||||
[ask-about-reset? #f])
|
||||
(define/public set-test-coverage-info
|
||||
(opt-lambda (ht [on-style #f] [off-style #f] [ask? #t])
|
||||
(λ (ht [on-style #f] [off-style #f] [ask? #t])
|
||||
(set! test-coverage-info ht)
|
||||
(set! test-coverage-on-style on-style)
|
||||
(set! test-coverage-off-style off-style)
|
||||
|
|
@ -903,11 +921,11 @@ profile todo:
|
|||
|
||||
(define/public (show-test-coverage-annotations ht on-style off-style ask?)
|
||||
(set! ask-about-reset? ask?)
|
||||
(let* ([edit-sequence-ht (make-hash-table)]
|
||||
[locked-ht (make-hash-table)]
|
||||
[already-frozen-ht (make-hash-table)]
|
||||
[actions-ht (make-hash-table 'equal)]
|
||||
[on/syntaxes (hash-table-map ht (λ (_ pr) pr))]
|
||||
(let* ([edit-sequence-ht (make-hasheq)]
|
||||
[locked-ht (make-hasheq)]
|
||||
[already-frozen-ht (make-hasheq)]
|
||||
[actions-ht (make-hash)]
|
||||
[on/syntaxes (hash-map ht (λ (_ pr) pr))]
|
||||
|
||||
;; can-annotate : (listof (list boolean srcloc))
|
||||
;; boolean is #t => code was run
|
||||
|
|
@ -931,21 +949,21 @@ profile todo:
|
|||
;; remove redundant expressions
|
||||
[filtered
|
||||
(let (;; actions-ht : (list src number number) -> (list boolean syntax)
|
||||
[actions-ht (make-hash-table 'equal)])
|
||||
[actions-ht (make-hash)])
|
||||
(for-each
|
||||
(λ (pr)
|
||||
(let* ([on? (list-ref pr 0)]
|
||||
[key (list-ref pr 1)]
|
||||
[old (hash-table-get actions-ht key 'nothing)])
|
||||
[old (hash-ref actions-ht key 'nothing)])
|
||||
(cond
|
||||
[(eq? old 'nothing) (hash-table-put! actions-ht key on?)]
|
||||
[(eq? old 'nothing) (hash-set! actions-ht key on?)]
|
||||
[old ;; recorded as executed
|
||||
(void)]
|
||||
[(not old) ;; recorded as unexected
|
||||
(when on?
|
||||
(hash-table-put! actions-ht key #t))])))
|
||||
(hash-set! actions-ht key #t))])))
|
||||
can-annotate)
|
||||
(hash-table-map actions-ht (λ (k v) (list v k))))])
|
||||
(hash-map actions-ht (λ (k v) (list v k))))])
|
||||
|
||||
;; if everything is covered *and* no coloring has been done, do no coloring.
|
||||
(unless (and (andmap car filtered)
|
||||
|
|
@ -981,14 +999,14 @@ profile todo:
|
|||
(for-each
|
||||
(λ (pr)
|
||||
(let ([src (srcloc-source (list-ref pr 1))])
|
||||
(hash-table-get
|
||||
(hash-ref
|
||||
edit-sequence-ht
|
||||
src
|
||||
(λ ()
|
||||
(hash-table-put! edit-sequence-ht src #f)
|
||||
(hash-set! edit-sequence-ht src #f)
|
||||
(send src begin-edit-sequence #f)
|
||||
(when (send src is-locked?)
|
||||
(hash-table-put! locked-ht src #t)
|
||||
(hash-set! locked-ht src #t)
|
||||
(send src lock #f))))))
|
||||
sorted)
|
||||
|
||||
|
|
@ -998,11 +1016,11 @@ profile todo:
|
|||
(set! internal-clear-test-coverage-display #f))
|
||||
|
||||
;; freeze the colorers, but avoid a second freeze (so we can avoid a second thaw)
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
edit-sequence-ht
|
||||
(λ (src _)
|
||||
(if (send src is-frozen?)
|
||||
(hash-table-put! already-frozen-ht src #t)
|
||||
(hash-set! already-frozen-ht src #t)
|
||||
(send src freeze-colorer))))
|
||||
|
||||
;; set new annotations
|
||||
|
|
@ -1023,23 +1041,23 @@ profile todo:
|
|||
sorted)
|
||||
|
||||
;; relock editors
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
locked-ht
|
||||
(λ (txt _) (send txt lock #t)))
|
||||
|
||||
;; end edit sequences
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
edit-sequence-ht
|
||||
(λ (txt _) (send txt end-edit-sequence)))
|
||||
|
||||
;; save thunk to reset these new annotations
|
||||
(set! internal-clear-test-coverage-display
|
||||
(λ ()
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
edit-sequence-ht
|
||||
(λ (txt _)
|
||||
(send txt begin-edit-sequence #f)))
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
edit-sequence-ht
|
||||
(λ (txt _)
|
||||
(let ([locked? (send txt is-locked?)])
|
||||
|
|
@ -1050,10 +1068,10 @@ profile todo:
|
|||
(send txt last-position)
|
||||
#f)
|
||||
(when locked? (send txt lock #t)))))
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
edit-sequence-ht
|
||||
(λ (txt _)
|
||||
(unless (hash-table-get already-frozen-ht txt #f)
|
||||
(unless (hash-ref already-frozen-ht txt #f)
|
||||
(let ([locked? (send txt is-locked?)])
|
||||
(when locked? (send txt lock #f))
|
||||
(send txt thaw-colorer)
|
||||
|
|
@ -1097,7 +1115,7 @@ profile todo:
|
|||
;; number[time spent in all calls]
|
||||
;; (union #f symbol)
|
||||
;; expression)
|
||||
(define-struct prof-info (nest num time name expr))
|
||||
(define-struct prof-info (nest num time name expr) #:mutable)
|
||||
|
||||
;; copy-prof-info : prof-info -> prof-info
|
||||
(define (copy-prof-info prof-info)
|
||||
|
|
@ -1134,12 +1152,12 @@ profile todo:
|
|||
(when rep
|
||||
(let ([ut (eventspace-handler-thread (send rep get-user-eventspace))])
|
||||
(when (eq? ut (current-thread))
|
||||
(let ([ht (make-hash-table)])
|
||||
(let ([ht (make-hasheq)])
|
||||
(thread-cell-set! current-profile-info ht)
|
||||
(send (send rep get-context) add-profile-info ht)))))))
|
||||
(let ([profile-info (thread-cell-ref current-profile-info)])
|
||||
(when profile-info
|
||||
(hash-table-put! profile-info
|
||||
(hash-set! profile-info
|
||||
key
|
||||
(make-prof-info #f 0 0 (and (syntax? name) (syntax-e name)) expr))))
|
||||
(void))
|
||||
|
|
@ -1150,7 +1168,7 @@ profile todo:
|
|||
(define (register-profile-start key)
|
||||
(let ([ht (thread-cell-ref current-profile-info)])
|
||||
(when ht
|
||||
(let ([info (hash-table-get ht key)])
|
||||
(let ([info (hash-ref ht key)])
|
||||
(set-prof-info-num! info (+ (prof-info-num info) 1))
|
||||
(if (prof-info-nest info)
|
||||
#f
|
||||
|
|
@ -1165,7 +1183,7 @@ profile todo:
|
|||
(when start
|
||||
(let ([ht (thread-cell-ref current-profile-info)])
|
||||
(when ht
|
||||
(let ([info (hash-table-get ht key)])
|
||||
(let ([info (hash-ref ht key)])
|
||||
(set-prof-info-nest! info #f)
|
||||
(set-prof-info-time! info
|
||||
(+ (- (current-process-milliseconds) start)
|
||||
|
|
@ -1315,7 +1333,7 @@ profile todo:
|
|||
(let/ec esc-k
|
||||
(for-each
|
||||
(λ (ht)
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
ht
|
||||
(λ (key v)
|
||||
(when (any-info? v)
|
||||
|
|
@ -1561,7 +1579,7 @@ profile todo:
|
|||
[(null? profile-info) (void)]
|
||||
[else
|
||||
(let ([ht (car profile-info)])
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
ht
|
||||
(λ (key val)
|
||||
(when (any-info? val)
|
||||
|
|
@ -1571,7 +1589,7 @@ profile todo:
|
|||
;; each editor that gets some highlighting is put
|
||||
;; into this table and an edit sequence is begun for it.
|
||||
;; after all ranges are updated, the edit sequences are all closed.
|
||||
[in-edit-sequence (make-hash-table)]
|
||||
[in-edit-sequence (make-hasheq)]
|
||||
[clear-highlight void]
|
||||
[max-value (extract-maximum infos)]
|
||||
[show-highlight
|
||||
|
|
@ -1584,8 +1602,8 @@ profile todo:
|
|||
(is-a? src text:basic<%>)
|
||||
(number? pos)
|
||||
(number? span))
|
||||
(unless (hash-table-get in-edit-sequence src (λ () #f))
|
||||
(hash-table-put! in-edit-sequence src #t)
|
||||
(unless (hash-ref in-edit-sequence src (λ () #f))
|
||||
(hash-set! in-edit-sequence src #t)
|
||||
(send src begin-edit-sequence))
|
||||
(let* ([color (get-color-value
|
||||
(if (eq? (preferences:get 'drscheme:profile-how-to-count) 'time)
|
||||
|
|
@ -1684,17 +1702,17 @@ profile todo:
|
|||
(cleanup-editor time-editor)
|
||||
(cleanup-editor src-loc-editor)
|
||||
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
in-edit-sequence
|
||||
(λ (key val)
|
||||
(send key end-edit-sequence)))
|
||||
(set! clear-old-results
|
||||
(λ ()
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
in-edit-sequence
|
||||
(λ (key val) (send key begin-edit-sequence)))
|
||||
(clear-highlight)
|
||||
(hash-table-for-each
|
||||
(hash-for-each
|
||||
in-edit-sequence
|
||||
(λ (key val) (send key end-edit-sequence)))
|
||||
(set! clear-old-results void))))
|
||||
|
|
@ -1951,4 +1969,4 @@ profile todo:
|
|||
|
||||
|
||||
|
||||
(define-values/invoke-unit/infer stacktrace@)))
|
||||
(define-values/invoke-unit/infer stacktrace@))
|
||||
|
|
@ -52,26 +52,26 @@
|
|||
test-coverage-tab-mixin))
|
||||
(define-signature drscheme:debug^ extends drscheme:debug-cm^
|
||||
(make-debug-error-display-handler
|
||||
make-debug-error-display-handler/text
|
||||
make-debug-eval-handler
|
||||
hide-backtrace-window
|
||||
print-bug-to-stderr
|
||||
error-display-handler/stacktrace
|
||||
|
||||
test-coverage-enabled
|
||||
|
||||
profiling-enabled
|
||||
|
||||
add-prefs-panel
|
||||
|
||||
get-error-color
|
||||
|
||||
show-error-and-highlight
|
||||
open-and-highlight-in-file
|
||||
hide-backtrace-window
|
||||
show-backtrace-window
|
||||
open-and-highlight-in-file
|
||||
get-cm-key
|
||||
|
||||
display-srcloc-in-error
|
||||
show-syntax-error-context))
|
||||
;show-error-and-highlight
|
||||
;print-bug-to-stderr
|
||||
;display-srclocs-in-error
|
||||
;show-syntax-error-context
|
||||
))
|
||||
|
||||
(define-signature drscheme:module-langauge-cm^
|
||||
(module-language<%>))
|
||||
|
|
|
|||
|
|
@ -19,7 +19,8 @@
|
|||
framework
|
||||
(lib "syntax-browser.ss" "mrlib")
|
||||
compiler/distribute
|
||||
compiler/bundle-dist)
|
||||
compiler/bundle-dist
|
||||
"rep.ss")
|
||||
|
||||
(import [prefix drscheme:debug: drscheme:debug^]
|
||||
[prefix drscheme:tools: drscheme:tools^]
|
||||
|
|
@ -106,21 +107,6 @@
|
|||
get-reader))
|
||||
|
||||
|
||||
|
||||
; ;;;
|
||||
;
|
||||
;
|
||||
;;; ;;; ;;; ; ; ;;; ; ;;;
|
||||
; ; ; ; ; ; ; ; ; ; ;
|
||||
;;; ; ; ; ; ; ; ; ;;;;;
|
||||
; ; ; ; ; ; ; ; ;
|
||||
; ; ; ; ; ; ; ; ; ; ;
|
||||
;;; ;;;;; ;; ; ;; ;;;; ;;;;;; ;;;
|
||||
;
|
||||
;
|
||||
;;;
|
||||
|
||||
|
||||
(define simple-module-based-language%
|
||||
(class* object% (simple-module-based-language<%>)
|
||||
(init-field module
|
||||
|
|
@ -131,7 +117,8 @@
|
|||
(documentation-reference #f)
|
||||
(reader (λ (src port)
|
||||
(let ([v (parameterize ([read-accept-reader #t])
|
||||
(read-syntax src port))])
|
||||
(with-stacktrace-name
|
||||
(read-syntax src port)))])
|
||||
(if (eof-object? v)
|
||||
v
|
||||
(namespace-syntax-introduce v)))))
|
||||
|
|
@ -149,19 +136,6 @@
|
|||
|
||||
|
||||
|
||||
;; ;;; ;; ;;
|
||||
; ; ; ;
|
||||
; ; ; ; ;
|
||||
; ;;; ; ;;; ;;;; ;; ;; ; ;;; ;;;; ;;;; ;;; ;;; ;;;;
|
||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||
;;;;; ; ; ; ; ; ; ; ; ; ; ; ;;;;; ;;;;; ; ; ;;;; ;;; ;;;;; ; ;
|
||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||
; ;; ; ;; ;;; ;;; ; ;;; ; ;;;;;; ;;; ; ;;; ;;; ; ;;; ;;; ;;; ;
|
||||
|
||||
|
||||
|
||||
|
||||
;; simple-module-based-language->module-based-language : module-based-language<%>
|
||||
;; transforms a simple-module-based-language into a module-based-language<%>
|
||||
(define simple-module-based-language->module-based-language-mixin
|
||||
|
|
@ -502,23 +476,6 @@
|
|||
(read-case-sensitive ,(simple-settings-case-sensitive setting)))))
|
||||
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;
|
||||
; ;
|
||||
; ; ;;;; ; ;;; ;;; ;;; ;; ;;;; ;;; ; ;;;
|
||||
; ; ; ;; ; ; ; ; ; ; ; ; ; ;
|
||||
;;;;; ; ; ;;;; ; ; ; ; ; ; ;;;; ; ; ;;;;;
|
||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||
; ;;;;;; ;;; ;;;; ;; ;;;; ;;; ; ;;; ; ;;;; ;;;
|
||||
; ;
|
||||
; ;
|
||||
;;; ;;;
|
||||
|
||||
|
||||
|
||||
;; module-based-language->language : module-based-language -> language<%>
|
||||
;; given a module-based-language, implements a language
|
||||
(define module-based-language->language-mixin
|
||||
|
|
@ -1147,7 +1104,8 @@
|
|||
(namespace-syntax-introduce
|
||||
(datum->syntax
|
||||
#f
|
||||
(cons '#%top-interaction s)))
|
||||
(cons '#%top-interaction s)
|
||||
s))
|
||||
s))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -424,8 +424,7 @@
|
|||
stx))
|
||||
;; rewrite the module to use the scheme/base version of `module'
|
||||
(values v-name
|
||||
#`(#,(datum->syntax #'here 'module)
|
||||
name lang bodies ...)))]
|
||||
#`(#,(datum->syntax #'here 'module) name lang bodies ...)))]
|
||||
[else
|
||||
(raise-syntax-error 'module-language
|
||||
"only module expressions are allowed"
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
#lang scheme/base
|
||||
|
||||
#|
|
||||
|
||||
TODO
|
||||
|
|
@ -17,47 +19,41 @@ TODO
|
|||
;; original stdin/stdout of drscheme, instead of the
|
||||
;; user's io ports, to aid any debugging printouts.
|
||||
;; (esp. useful when debugging the users's io)
|
||||
(module rep mzscheme
|
||||
(require mzlib/class
|
||||
mzlib/file
|
||||
mzlib/pretty
|
||||
mzlib/etc
|
||||
mzlib/list
|
||||
mzlib/port
|
||||
mzlib/unit
|
||||
|
||||
(require scheme/class
|
||||
scheme/path
|
||||
scheme/pretty
|
||||
scheme/unit
|
||||
scheme/list
|
||||
"drsig.ss"
|
||||
string-constants
|
||||
mred
|
||||
setup/xref
|
||||
scheme/gui/base
|
||||
framework
|
||||
(lib "external.ss" "browser")
|
||||
(lib "default-lexer.ss" "syntax-color"))
|
||||
browser/external)
|
||||
|
||||
(provide rep@)
|
||||
(provide rep@ with-stacktrace-name)
|
||||
|
||||
(define-struct unsaved-editor (editor))
|
||||
|
||||
(define-syntax stacktrace-name (string->uninterned-symbol "this-is-the-funny-name"))
|
||||
(define stacktrace-runtime-name
|
||||
(string->uninterned-symbol "this-is-the-funny-name"))
|
||||
|
||||
;; this macro wraps its argument expression in some code in a non-tail manner
|
||||
;; this function wraps its argument expression in some code in a non-tail manner
|
||||
;; so that a new name gets put onto the mzscheme stack. DrScheme's exception
|
||||
;; handlers trims the stack starting at this point to avoid showing drscheme's
|
||||
;; internals on the stack in the REPL.
|
||||
(define-syntax (with-stacktrace-name stx)
|
||||
(syntax-case stx ()
|
||||
[(_ e)
|
||||
(with-syntax ([my-funny-name (syntax-local-value #'stacktrace-name)])
|
||||
(syntax
|
||||
(let ([my-funny-name (λ () (begin0 e (parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)])
|
||||
(random 1))))])
|
||||
((if (zero? (parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)])
|
||||
(random 1)))
|
||||
my-funny-name
|
||||
values)))))]))
|
||||
(define call-with-stacktrace-name
|
||||
(eval `(let ([,stacktrace-runtime-name
|
||||
(lambda (thunk)
|
||||
(begin0
|
||||
(thunk)
|
||||
(void)))])
|
||||
,stacktrace-runtime-name)
|
||||
(make-base-namespace)))
|
||||
|
||||
(define stacktrace-runtime-name
|
||||
(let-syntax ([m (λ (x) (with-syntax ([x (syntax-local-value #'stacktrace-name)])
|
||||
(syntax 'x)))])
|
||||
(m)))
|
||||
(define-syntax-rule (with-stacktrace-name expr)
|
||||
(call-with-stacktrace-name (lambda () expr)))
|
||||
|
||||
(define no-breaks-break-parameterization
|
||||
(parameterize-break
|
||||
|
|
@ -222,21 +218,7 @@ TODO
|
|||
(continuation-mark-set->context (exn-continuation-marks exn)))
|
||||
(printf "\n"))
|
||||
|
||||
(unless (null? stack)
|
||||
(drscheme:debug:print-bug-to-stderr msg stack))
|
||||
(for-each drscheme:debug:display-srcloc-in-error src-locs)
|
||||
(display msg (current-error-port))
|
||||
(when (exn:fail:syntax? exn)
|
||||
(drscheme:debug:show-syntax-error-context (current-error-port) exn))
|
||||
(newline (current-error-port))
|
||||
(flush-output (current-error-port))
|
||||
(let ([rep (current-rep)])
|
||||
(when (and (is-a? rep -text<%>)
|
||||
(eq? (current-error-port) (send rep get-err-port)))
|
||||
(parameterize ([current-eventspace drscheme:init:system-eventspace])
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(send rep highlight-errors src-locs stack))))))))
|
||||
(drscheme:debug:error-display-handler/stacktrace msg exn stack)))
|
||||
|
||||
(define (main-user-eventspace-thread?)
|
||||
(let ([rep (current-rep)])
|
||||
|
|
@ -265,30 +247,43 @@ TODO
|
|||
[else (cons top (loop (cdr stack)))]))]))))
|
||||
|
||||
;; is-cut? : any symbol -> boolean
|
||||
;; determines if this stack entry is really
|
||||
;; determines if this stack entry is drscheme's barrier in the stacktrace
|
||||
(define (cut-here? top)
|
||||
(and (pair? top)
|
||||
(let* ([fn-name (car top)]
|
||||
[srcloc (cdr top)]
|
||||
[source (and srcloc (srcloc-source srcloc))])
|
||||
(and (eq? fn-name stacktrace-runtime-name)
|
||||
(path? source)
|
||||
(let loop ([path source]
|
||||
[pieces '(#"rep.ss" #"private" #"drscheme" #"collects")])
|
||||
(cond
|
||||
[(null? pieces) #t]
|
||||
[else
|
||||
(let-values ([(base name dir?) (split-path path)])
|
||||
(and (equal? (path-element->bytes name) (car pieces))
|
||||
(loop base (cdr pieces))))]))))))
|
||||
(let ([fn-name (car top)])
|
||||
(eq? fn-name stacktrace-runtime-name))))
|
||||
|
||||
(define drs-bindings-keymap (make-object keymap:aug-keymap%))
|
||||
|
||||
(let ([with-drs-frame
|
||||
(λ (obj f)
|
||||
(when (is-a? obj editor<%>)
|
||||
(let ([canvas (send obj get-canvas)])
|
||||
(when canvas
|
||||
(let ([frame (send canvas get-top-level-window)])
|
||||
(when (is-a? frame drscheme:unit:frame%)
|
||||
(f frame)))))))])
|
||||
|
||||
(send drs-bindings-keymap add-function
|
||||
"search-help-desk"
|
||||
(λ (obj evt)
|
||||
(with-drs-frame
|
||||
obj
|
||||
(λ (frame)
|
||||
(cond
|
||||
[(is-a? obj text%)
|
||||
|
||||
;; this just uses the thunk argument of load-collections-xref in order
|
||||
;; to ensure that there is some GUI feedback the first time the help
|
||||
;; desk index is loaded.
|
||||
(when frame
|
||||
(let ([id 'loading-docs])
|
||||
(send frame open-status-line id)
|
||||
(load-collections-xref
|
||||
(λ ()
|
||||
(send frame update-status-line id (string-constant help-desk-loading-documentation-index))))
|
||||
(send frame close-status-line id)))
|
||||
|
||||
(let* ([start (send obj get-start-position)]
|
||||
[end (send obj get-end-position)]
|
||||
[str (if (= start end)
|
||||
|
|
@ -304,15 +299,7 @@ TODO
|
|||
get-next-settings)))))])
|
||||
(drscheme:help-desk:help-desk str))))]
|
||||
[else
|
||||
(drscheme:help-desk:help-desk)])))
|
||||
(let ([with-drs-frame
|
||||
(λ (obj f)
|
||||
(when (is-a? obj editor<%>)
|
||||
(let ([canvas (send obj get-canvas)])
|
||||
(when canvas
|
||||
(let ([frame (send canvas get-top-level-window)])
|
||||
(when (is-a? frame drscheme:unit:frame%)
|
||||
(f frame)))))))])
|
||||
(drscheme:help-desk:help-desk)])))))
|
||||
|
||||
(send drs-bindings-keymap add-function
|
||||
"execute"
|
||||
|
|
@ -619,7 +606,7 @@ TODO
|
|||
|
||||
;; =User= (probably doesn't matter)
|
||||
(define/private queue-system-callback
|
||||
(opt-lambda (ut thunk [always? #f])
|
||||
(λ (ut thunk [always? #f])
|
||||
(parameterize ([current-eventspace drscheme:init:system-eventspace])
|
||||
(queue-callback
|
||||
(λ ()
|
||||
|
|
@ -790,13 +777,13 @@ TODO
|
|||
;; duplicate arrows point from and to the same place -- only
|
||||
;; need one arrow for each pair of locations they point to.
|
||||
(define/private (remove-duplicate-error-arrows error-arrows)
|
||||
(let ([ht (make-hash-table 'equal)])
|
||||
(let ([ht (make-hash)])
|
||||
(let loop ([arrs error-arrows]
|
||||
[n 0])
|
||||
(unless (null? arrs)
|
||||
(hash-table-put! ht (car arrs) n)
|
||||
(hash-set! ht (car arrs) n)
|
||||
(loop (cdr arrs) (+ n 1))))
|
||||
(let* ([unsorted (hash-table-map ht list)]
|
||||
(let* ([unsorted (hash-map ht list)]
|
||||
[sorted (sort unsorted (λ (x y) (<= (cadr x) (cadr y))))]
|
||||
[arrs (map car sorted)])
|
||||
arrs)))
|
||||
|
|
@ -999,7 +986,7 @@ TODO
|
|||
|
||||
(let* ([old-regions (get-regions)]
|
||||
[abl (all-but-last old-regions)]
|
||||
[lst (car (last-pair old-regions))])
|
||||
[lst (last old-regions)])
|
||||
(reset-regions (append abl (list (list (list-ref lst 0) (last-position))))))
|
||||
|
||||
(let ([needs-execution (send context needs-execution)])
|
||||
|
|
@ -1421,7 +1408,7 @@ TODO
|
|||
(define/private (initialize-dispatch-handler) ;;; =User=
|
||||
(let* ([primitive-dispatch-handler (event-dispatch-handler)])
|
||||
(event-dispatch-handler
|
||||
(rec drscheme-event-dispatch-handler ; <= a name for #<...> printout
|
||||
(letrec ([drscheme-event-dispatch-handler ; <= a name for #<...> printout
|
||||
(λ (eventspace) ; =User=, =Handler=
|
||||
; Breaking is enabled if the user turned on breaks and
|
||||
; is in a `yield'. If we get a break, that's ok, because
|
||||
|
|
@ -1459,7 +1446,8 @@ TODO
|
|||
(primitive-dispatch-handler eventspace)])]
|
||||
[else
|
||||
; =User=, =Non-Handler=, =No-Breaks=
|
||||
(primitive-dispatch-handler eventspace)]))))))
|
||||
(primitive-dispatch-handler eventspace)]))])
|
||||
drscheme-event-dispatch-handler))))
|
||||
|
||||
(define/public (new-empty-console)
|
||||
(queue-user/wait
|
||||
|
|
@ -1768,7 +1756,7 @@ TODO
|
|||
(insert/delta text (format "~a" (exn-message exn)) error-delta)
|
||||
(when (syntax? expr)
|
||||
(insert/delta text " in: ")
|
||||
(insert/delta text (format "~s" (syntax-object->datum expr)) error-text-style-delta))
|
||||
(insert/delta text (format "~s" (syntax->datum expr)) error-text-style-delta))
|
||||
(insert/delta text "\n")
|
||||
(when (and (is-a? src text:basic%)
|
||||
(number? pos)
|
||||
|
|
@ -1849,4 +1837,4 @@ TODO
|
|||
(drs-autocomplete-mixin
|
||||
(λ (txt) (send txt get-definitions-text))
|
||||
(text:foreground-color-mixin
|
||||
text:clever-file-format%))))))))))))))
|
||||
text:clever-file-format%)))))))))))))
|
||||
|
|
@ -1124,13 +1124,10 @@ If the namespace does not, they are colored the unbound color.
|
|||
(λ () ;; =drs=
|
||||
(show-error-report/tab))))
|
||||
|
||||
(drscheme:debug:show-error-and-highlight
|
||||
msg exn
|
||||
(λ (src-to-display cms) ;; =user=
|
||||
(parameterize ([current-eventspace drs-eventspace])
|
||||
(queue-callback
|
||||
(λ () ;; =drs=
|
||||
(send (send the-tab get-ints) highlight-errors src-to-display cms))))))
|
||||
(drscheme:debug:error-display-handler/stacktrace
|
||||
msg
|
||||
exn
|
||||
'())
|
||||
|
||||
(semaphore-post error-display-semaphore)))
|
||||
|
||||
|
|
|
|||
|
|
@ -296,18 +296,20 @@ all of the names in the tools library, for use defining keybindings
|
|||
; ;;;;
|
||||
|
||||
(proc-doc/names
|
||||
drscheme:debug:show-error-and-highlight
|
||||
(-> string?
|
||||
(or/c any/c exn?)
|
||||
(-> (listof srcloc?) (or/c false/c (listof (list/c (is-a?/c text%) number? number?))) any)
|
||||
drscheme:debug:error-display-handler/stacktrace
|
||||
(->* (string? any/c)
|
||||
((or/c false/c (listof srcloc?)))
|
||||
any)
|
||||
(msg exn highlight-errors)
|
||||
@{The first two arguments are the same as the arguments to the error-display-handler.
|
||||
This function prints the error message to the current-error-port, like the default error-display-handler
|
||||
and also calls @scheme[highlight-errors] to do error highlighting. It is be passed the stack trace
|
||||
for the error message.
|
||||
((msg exn) ((stack #f)))
|
||||
@{Displays the error message represented by the string, adding
|
||||
embellishments like those that appears in the DrScheme REPL,
|
||||
specifically a clickable icon for the stack trace (if the srcloc location is not empty),
|
||||
and a clickable icon for the source of the error (read & syntax errors show their source
|
||||
locations and otherwise the first place in the stack trace is shown).
|
||||
|
||||
This function should be called on the same thread/eventspace where the error happened.})
|
||||
If @scheme[stack] is false, then the stack trace embedded in the @scheme[exn] argument (if any) is used.
|
||||
|
||||
This should be called in the same eventspace and on the same thread as the error.})
|
||||
|
||||
(proc-doc/names
|
||||
drscheme:debug:make-debug-error-display-handler
|
||||
|
|
@ -323,7 +325,7 @@ all of the names in the tools library, for use defining keybindings
|
|||
@scheme[drscheme:debug:make-debug-eval-handler].
|
||||
|
||||
See also MzScheme's
|
||||
MzLink{mz:p:error-display-handler}{error-display-handler}
|
||||
@scheme[error-display-handler]
|
||||
parameter.
|
||||
|
||||
If the current-error-port is the definitions window in
|
||||
|
|
@ -345,7 +347,7 @@ all of the names in the tools library, for use defining keybindings
|
|||
This function is designed to work in conjunction with
|
||||
@scheme[drscheme:debug:make-debug-error-display-handler].
|
||||
|
||||
See also MzScheme's MzLink{mz:p:eval-handler}{eval-handler}
|
||||
See also MzScheme's @scheme[eval-handler]
|
||||
parameter.
|
||||
|
||||
The resulting eval-handler expands and annotates the input
|
||||
|
|
@ -384,10 +386,8 @@ all of the names in the tools library, for use defining keybindings
|
|||
(srcloc? . -> . void?)
|
||||
(debug-info)
|
||||
@{This function opens a DrScheme to display
|
||||
@scheme[debug-info]. The first element in
|
||||
the cons indicates where the file is
|
||||
and the two number indicate a range of
|
||||
text to show.
|
||||
@scheme[debug-info]. Only the src the position
|
||||
and the span fields of the srcloc are considered.
|
||||
|
||||
See also
|
||||
@scheme[drscheme:debug:get-cm-key].})
|
||||
|
|
|
|||
BIN
collects/icons/stop-16x16.png
Normal file
BIN
collects/icons/stop-16x16.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 836 B |
Binary file not shown.
|
Before Width: | Height: | Size: 1.8 KiB After Width: | Height: | Size: 1.1 KiB |
|
|
@ -329,6 +329,11 @@ please adhere to these guidelines:
|
|||
(help-desk-this-is-just-example-text
|
||||
"This is just example text for setting the font size. Open Help Desk proper (from Help menu) to follow these links.")
|
||||
|
||||
;; this appears in the bottom part of the frame the first time the user hits `f1'
|
||||
;; (assuming nothing else has loaded the documentation index first)
|
||||
;; see also: cs-status-loading-docs-index
|
||||
(help-desk-loading-documentation-index "Help Desk: loading documentation index")
|
||||
|
||||
;; Help desk htty proxy
|
||||
(http-proxy "HTTP Proxy")
|
||||
(proxy-direct-connection "Direct connection")
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -45,7 +45,7 @@
|
|||
(regexp "first>"))
|
||||
(make-test "(module m mzscheme (require (all-except (lib \"list.ss\") foldl)))"
|
||||
"foldl"
|
||||
". reference to an identifier before its definition: foldl")
|
||||
". . reference to an identifier before its definition: foldl")
|
||||
|
||||
(make-test "(module m mzscheme (require (prefix mz: mzscheme)))" "mz:+" #rx"procedure:+")
|
||||
|
||||
|
|
@ -72,7 +72,7 @@
|
|||
`(module m (file ,(path->string (build-path this-dir "module-lang-test-tmp.ss")))
|
||||
x))
|
||||
"+"
|
||||
". reference to an identifier before its definition: +")
|
||||
". . reference to an identifier before its definition: +")
|
||||
|
||||
(make-test (format "~s" '(module m mzscheme (provide lambda)))
|
||||
"(lambda (x) x)"
|
||||
|
|
@ -83,14 +83,14 @@
|
|||
"1")
|
||||
(make-test (format "~s" '(module m mzscheme (define-syntax s (syntax 1)) (provide s)))
|
||||
"s"
|
||||
"s: illegal use of syntax in: s")
|
||||
". s: illegal use of syntax in: s")
|
||||
|
||||
(make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define a 10)) x x))
|
||||
"a"
|
||||
". reference to an identifier before its definition: a")
|
||||
". . reference to an identifier before its definition: a")
|
||||
(make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define-syntax (a stx) #'10)) x x))
|
||||
"a"
|
||||
". reference to an identifier before its definition: a")
|
||||
". . reference to an identifier before its definition: a")
|
||||
(make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define a 10)) x x (define a 77)))
|
||||
"a"
|
||||
"77")
|
||||
|
|
@ -210,7 +210,7 @@
|
|||
[(regexp? (test-result test))
|
||||
(regexp-match (test-result test) after-int-output)])])
|
||||
(unless passed?
|
||||
(printf "FAILED: ~a\n ~a\n expected: ~a\n got: ~a\n"
|
||||
(printf "FAILED: ~a\n ~a\n expected: ~s\n got: ~s\n"
|
||||
(test-definitions test)
|
||||
(or (test-interactions test) 'no-interactions)
|
||||
(test-result test)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -18,6 +18,10 @@
|
|||
. removed help-desk:help-desk from the tools interface.
|
||||
Use the help collection instead.
|
||||
|
||||
. removed drscheme:debug:show-error-and-highlight from
|
||||
the tools interface. Use drscheme:debug:error-display-handler/stacktrace
|
||||
instead.
|
||||
|
||||
------------------------------
|
||||
Version 372
|
||||
------------------------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user