expander: improve error reporting of conflicts during require

Adds an additional line to the error message that is raised when a
required module provides a binding that is already provided by another
required module.  The additional line displays the name of the first
module that provides the binding.

The error before this change:

    tmp/c.rkt:4:9: module: identifier already required
      at: x
      in: "b.rkt"
      location...:
       tmp/c.rkt:4:9

and after:

    tmp/c.rkt:4:9: module: identifier already required
      at: x
      in: "b.rkt"
      also provided by: "a.rkt"
      location...:
       tmp/c.rkt:4:9
This commit is contained in:
Bogdan Popa 2019-10-01 18:23:21 +03:00 committed by Matthew Flatt
parent 8ff88b5e77
commit f7c85e1788
3 changed files with 40 additions and 8 deletions

View File

@ -3008,6 +3008,25 @@ case of module-leve bindings; it doesn't cover local bindings.
(eval '(require (submod "." inner)))
(test 'yes eval 'i))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check reporting of require conflicts includes "who" provided the binding first
(module require-conflict-is-sourced-a racket/base
(provide x)
(define x 'a))
(module require-conflict-is-sourced-b racket/base
(provide x)
(define x 'b))
(err/rt-test
(eval
'(module m racket/base
(require 'require-conflict-is-sourced-a
'require-conflict-is-sourced-b)))
(lambda (exn)
(regexp-match? #rx"already required\n at: x\n in: \\(quote require-conflict-is-sourced-b\\)\n also provided by: \\(quote require-conflict-is-sourced-a\\)" (exn-message exn))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -318,7 +318,7 @@
(if (procedure? ok-binding/delayed)
(ok-binding/delayed)
ok-binding/delayed)))
(define (raise-already-bound defined?)
(define (raise-already-bound defined? where)
(raise-syntax-error who
(string-append "identifier already "
(if defined? "defined" "required")
@ -328,7 +328,12 @@
[(= 1 phase) " for syntax"]
[else (format " for phase ~a" phase)]))
orig-s
id))
id
null
(cond
[(bulk-required? where)
(format "\n also provided by: ~.s" (syntax->datum (bulk-required-s where)))]
[else ""])))
(cond
[(and (not at-mod)
(not define-shadowing-require?))
@ -364,7 +369,7 @@
(define also-required (requires+provides-also-required r+p))
(define prev-b (hash-ref also-required (module-binding-sym b) #f))
(when (and prev-b (not (same-binding? ok-binding prev-b)))
(raise-already-bound #f))
(raise-already-bound #f #f))
(hash-set! also-required (module-binding-sym b) ok-binding)
(set-requires+provides-all-bindings-simple?! r+p #f)
#t]
@ -382,7 +387,7 @@
(set-requires+provides-all-bindings-simple?! r+p #f)
only-can-can-shadow-require?]
[define-shadowing-require? #f]
[else (raise-already-bound defined?)])))
[else (raise-already-bound defined? r)])))
(cond
[define-shadowing-require?
;; Not defined, but defining now (shadowing all requires);

View File

@ -24955,7 +24955,7 @@ static const char *startup_source =
" ok-binding/delayed_0)"
" #f)))"
"(let-values(((raise-already-bound_0)"
"(lambda(defined?_1)"
"(lambda(defined?_1 where_0)"
"(begin"
" 'raise-already-bound"
"(raise-syntax-error$1"
@ -24972,7 +24972,14 @@ static const char *startup_source =
"(let-values()"
" (format \" for phase ~a\" phase_0))))))"
" orig-s_0"
" id_0)))))"
" id_0"
" null"
"(if(bulk-required? where_0)"
"(let-values()"
"(format"
" \"\\n also provided by: ~.s\""
"(syntax->datum$1(bulk-required-s where_0))))"
" (let-values () \"\")))))))"
"(if(if(not at-mod_0)(not define-shadowing-require?_0) #f)"
"(let-values() #f)"
"(if(if ok-binding_0(same-binding? b_0 ok-binding_0) #f)"
@ -25037,7 +25044,7 @@ static const char *startup_source =
"(if(if prev-b_0"
"(not(same-binding? ok-binding_0 prev-b_0))"
" #f)"
"(let-values()(raise-already-bound_0 #f))"
"(let-values()(raise-already-bound_0 #f #f))"
"(void))"
"(hash-set!"
" also-required_0"
@ -25104,7 +25111,8 @@ static const char *startup_source =
" #f)"
"(let-values()"
"(raise-already-bound_0"
" defined?_0)))))))"
" defined?_0"
" r_0)))))))"
"(values"
" only-can-can-shadow-require?_2)))))"
"(if(not"