diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index ec15e601e6..474c6d4faf 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -2083,7 +2083,27 @@ (evalx '(module m racket/base (provide e) (define e #'1))) (evalx '(module n racket/base (require (for-syntax 'm)) (provide s) (define-syntax (s stx) e))) (evalx '(require 'n)) - (err/rt-test (evalx 's) #rx"literal data is not allowed")) + (err/rt-test (evalx 's) (lambda (exn) (regexp-match? #rx"literal data is not allowed" (exn-message exn))))) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check source-location reporting by `raise-syntax-error` + +(let () + (define (check a0 a1 . args) + (err/rt-test (apply raise-syntax-error #f "oops" a0 a1 args) + (lambda (exn) + (and (exn:fail:syntax? exn) + (regexp-match? (format "^[^:\n]*:~a:~a:" + (or (syntax-line a1) + (syntax-line a0)) + (or (syntax-column a1) + (syntax-column a0))) + (exn-message exn)))))) + (define stx #'(a b)) + (define a-stx (car (syntax-e stx))) + (check stx a-stx) + (check stx #f) + (check #f a-stx)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c index a112dc1bbc..191463cec6 100644 --- a/racket/src/racket/src/error.c +++ b/racket/src/racket/src/error.c @@ -2360,7 +2360,16 @@ static void do_wrong_syntax(const char *where, where, s, slen, v, vlen); - } else + } else if (dv) + blen = scheme_sprintf(buffer, blen, + "%t%s%s: %t\n" + " at: %t", + p, plen, + p ? ": " : "", + where, + s, slen, + dv, dvlen); + else blen = scheme_sprintf(buffer, blen, "%s: %t", where, s, slen);