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

avoid printing stacktrace information when the exception is a exn:fail:user?.

Browse Source 
closes PR 11874
This commit is contained in:
Robby Findler 2011-04-24 07:45:07 -05:00
parent 020946cb2a
commit 41497cec6a
3 changed files with 38 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/drracket/private/debug.rkt
View File

@ -290,9 +290,10 @@ profile todo:
[src-locs-edition (and (pair? src-locs)
(srcloc->edition/pair defs ints (car src-locs)))])
(print-planet-icon-to-stderr exn)
(unless (exn:fail:user? exn)
(unless (null? stack)
(print-bug-to-stderr msg stack stack-editions defs ints))
(display-srclocs-in-error src-locs src-locs-edition)
(display-srclocs-in-error src-locs src-locs-edition))
(display msg (current-error-port))
(when (exn:fail:syntax? exn)
(unless (error-print-source-location)

6
collects/drracket/private/rep.rkt
View File

@ -204,13 +204,13 @@ TODO
;; a port that accepts values for printing in the repl
(define current-value-port (make-parameter #f))
;; drscheme-error-display-handler : (string (union #f exn) -> void
;; drracket-error-display-handler : (string (union #f exn) -> void
;; =User=
;; the timing is a little tricky here.
;; the file icon must appear before the error message in the text, so that happens first.
;; the highlight must be set after the error message, because inserting into the text resets
;; the highlighting.
(define (drscheme-error-display-handler msg exn)
(define (drracket-error-display-handler msg exn)
(let* ([cut-stack (if (and (exn? exn)
(main-user-eventspace-thread?))
(cut-stack-at-checkpoint exn)
@ -1493,7 +1493,7 @@ TODO
(current-language-settings user-language-settings)
(error-print-source-location #f)
(error-display-handler drscheme-error-display-handler)
(error-display-handler drracket-error-display-handler)
(current-load-relative-directory #f)
(current-custodian user-custodian)
(current-load text-editor-load-handler)

41
collects/tests/drracket/language-test.rkt
View File

@ -130,7 +130,9 @@ the settings above should match r5rs
(test-expression "(current-command-line-arguments)" "'#()")
(test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case")
(test-expression "#lang racket" #rx"module: illegal use \\(not at top-level\\)" #rx"read: #lang not enabled in the current context")))
(test-expression "#lang racket" #rx"module: illegal use \\(not at top-level\\)" #rx"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
"a: b")))
;
@ -232,7 +234,9 @@ the settings above should match r5rs
(test-expression "#lang racket"
""
#rx"read: #lang not enabled in the current context")))
#rx"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
"a: b")))
;
;
@ -340,7 +344,9 @@ the settings above should match r5rs
(test-expression "#lang racket"
(regexp (regexp-quote "#%module-begin: illegal use (not a module body) in: (#%module-begin)"))
#rx"read: #lang not enabled in the current context")))
#rx"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
#rx"reference to undefined identifier:")))
;
@ -505,7 +511,10 @@ the settings above should match r5rs
(test-expression "#lang racket"
"module: name is not defined, not a parameter, and not a primitive name"
"read: #lang not enabled in the current context")))
"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
"define: expected at least one argument name after the function name, but found none"
#rx"define: function definitions are not allowed in the interactions window")))
;
@ -673,7 +682,10 @@ the settings above should match r5rs
(test-expression "#lang racket"
"module: name is not defined, not a parameter, and not a primitive name"
"read: #lang not enabled in the current context")))
"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
"define: expected at least one argument name after the function name, but found none"
#rx"define: function definitions are not allowed in the interactions window")))
;
@ -833,7 +845,10 @@ the settings above should match r5rs
(test-expression "#lang racket"
"module: name is not defined, not a parameter, and not a primitive name"
"read: #lang not enabled in the current context")))
"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
"define: expected at least one argument name after the function name, but found none"
#rx"define: expected at least one argument name after the function name, but found none")))
@ -991,7 +1006,10 @@ the settings above should match r5rs
(test-expression "#lang racket"
"module: name is not defined, not a parameter, and not a primitive name"
"read: #lang not enabled in the current context")))
"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
"define: expected at least one argument name after the function name, but found none"
#rx"define: expected at least one argument name after the function name, but found none")))
@ -1149,7 +1167,10 @@ the settings above should match r5rs
(test-expression "#lang racket"
"module: name is not defined, not a parameter, and not a primitive name"
"read: #lang not enabled in the current context")))
"read: #lang not enabled in the current context")
(test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)"
#rx"raise-user-error"
#rx"raise-user-error")))
@ -1499,11 +1520,11 @@ the settings above should match r5rs
[(_ arg)
(identifier? (syntax arg))
(syntax (begin (flush-output)
(printf ">> starting ~a\n" (syntax->datum #'arg))
(printf ">> starting ~a\n" 'arg)
(flush-output)
(arg)
(flush-output)
(printf ">> finished ~a\n" (syntax->datum #'arg))
(printf ">> finished ~a\n" 'arg)
(flush-output)))]))
(define (run-test)