better error message when a library file "foo.ss" does not contain

the expected library name (foo).
This commit is contained in:
Abdulaziz Ghuloum 2008-06-05 00:58:04 -07:00
parent 81db526510
commit 6741ac2817
3 changed files with 31 additions and 14 deletions

View File

@ -1 +1 @@
1496
1498

View File

@ -3546,15 +3546,17 @@
macro* export-subst export-env))))))))))))))
(define core-library-expander
(lambda (e)
(let-values (((name* exp* imp* b*) (parse-library e)))
(let-values (((name ver) (parse-library-name name*)))
(let-values (((imp* invoke-req* visit-req* invoke-code
visit-code export-subst export-env)
(library-body-expander exp* imp* b* #f)))
(values name ver imp* invoke-req* visit-req*
invoke-code visit-code export-subst
export-env))))))
(case-lambda
[(e verify-name)
(let-values (((name* exp* imp* b*) (parse-library e)))
(let-values (((name ver) (parse-library-name name*)))
(verify-name name)
(let-values (((imp* invoke-req* visit-req* invoke-code
visit-code export-subst export-env)
(library-body-expander exp* imp* b* #f)))
(values name ver imp* invoke-req* visit-req*
invoke-code visit-code export-subst
export-env))))]))
(define (parse-top-level-program e*)
(syntax-match e* ()
@ -3665,7 +3667,7 @@
;;; returns its invoke-code, visit-code, subst and env.
(define library-expander
(case-lambda
[(x filename)
[(x filename verify-name)
(define (build-visit-code macro*)
(if (null? macro*)
(build-void)
@ -3681,7 +3683,7 @@
macro*))
(let-values (((name ver imp* inv* vis*
invoke-code macro* export-subst export-env)
(core-library-expander x)))
(core-library-expander x verify-name)))
(let ((id (gensym))
(name name)
(ver ver)
@ -3701,7 +3703,10 @@
(values id name ver imp* vis* inv*
invoke-code visit-code
export-subst export-env)))]
[(x) (library-expander x #f)]))
[(x filename)
(library-expander x filename (lambda (x) (values)))]
[(x)
(library-expander x #f (lambda (x) (values)))]))
;;; when bootstrapping the system, visit-code is not (and cannot
;;; be) be used in the "next" system. So, we drop it.

View File

@ -226,7 +226,19 @@
[else
((current-library-expander)
(read-library-source-file file-name)
file-name)])))
file-name
(lambda (name)
(unless (equal? name x)
(assertion-violation 'import
(let-values ([(p e) (open-string-output-port)])
(display "expected to find library " p)
(write x p)
(display " in file " p)
(display file-name p)
(display ", found " p)
(write name p)
(display " instead" p)
(e))))))])))
(lambda (f)
(if (procedure? f)
f