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

closes PR 11874

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)
+      (unless (exn:fail:user? exn)
-        (print-bug-to-stderr msg stack stack-editions defs ints))
+        (unless (null? stack)
-      (display-srclocs-in-error src-locs src-locs-edition)
+          (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)

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)

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)