diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt index e2684b5e65..8d5c41eb97 100644 --- a/collects/drracket/private/debug.rkt +++ b/collects/drracket/private/debug.rkt @@ -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 (null? stack) - (print-bug-to-stderr msg stack stack-editions defs ints)) - (display-srclocs-in-error src-locs src-locs-edition) + (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 msg (current-error-port)) (when (exn:fail:syntax? exn) (unless (error-print-source-location) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index 81b7fd9841..cbceb315e3 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -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) diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index 5b548a5ffb..864617c3aa 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -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)