cs: fix defined-name reporting

This commit is contained in:
Matthew Flatt 2019-11-29 16:48:17 -07:00
parent ec9c30d2f1
commit 406fe85144
3 changed files with 42 additions and 3 deletions

View File

@ -3169,6 +3169,32 @@ case of module-leve bindings; it doesn't cover local bindings.
exn:fail:contract:arity?
#rx"define-values: result arity mismatch")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure source-name tracking works across multiple definitions
(module tries-to-use-first-defined-function-too-early racket/base
(define-syntax-rule (go)
(begin
(f 1)
(define (f x) x)
(define (g y) y)))
(go))
(err/rt-test/once (dynamic-require ''tries-to-use-first-defined-function-too-early #f)
exn:fail:contract:variable?
#rx"^f:")
(module tries-to-use-second-defined-function-too-early racket/base
(define-syntax-rule (go)
(begin
(f 1)
(define (g y) y)
(define (f x) x)))
(go))
(err/rt-test/once (dynamic-require ''tries-to-use-second-defined-function-too-early #f)
exn:fail:contract:variable?
#rx"^f:")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -857,6 +857,17 @@
[else ""]))]
[else ""]))
(define (indentify-internal-name var)
(cond
[(error-print-source-location)
(cond
[(eq? (variable-name var) (variable-source-name var))
""]
[else
(string-append "\n internal name: "
(symbol->string (variable-name var)))])]
[else ""]))
(define (raise-undefined var set?)
(raise
(|#%app|
@ -866,11 +877,13 @@
(string-append "set!: assignment disallowed;\n"
" cannot set variable before its definition\n"
" variable: " (symbol->string (variable-source-name var))
(identify-module var))]
(identify-module var)
(indentify-internal-name var))]
[else
(string-append (symbol->string (variable-source-name var))
": undefined;\n cannot reference an identifier before its definition"
(identify-module var))])
(identify-module var)
(indentify-internal-name var))])
(current-continuation-marks)
(variable-name var))))

View File

@ -8,7 +8,7 @@
(for/fold ([src-syms #hasheq()]) ([body (in-list bodys)])
(match body
[`(define-values ,ids ,rhs)
(for/fold ([src-syms #hasheq()]) ([id (in-list ids)])
(for/fold ([src-syms src-syms]) ([id (in-list ids)])
(define u-id (unwrap id))
(define sym (or (wrap-property id 'source-name) u-id))
(cond