~ chicken-core (chicken-5) 67167bd7feb2b0f2fc543bc010552c9da701c16a
commit 67167bd7feb2b0f2fc543bc010552c9da701c16a Author: felix <felix@call-with-current-continuation.org> AuthorDate: Thu Oct 3 13:07:28 2019 +0200 Commit: Peter Bex <peter@more-magic.net> CommitDate: Sun Oct 6 11:29:47 2019 +0200 Extend export-identifier check When finalizing a module, ensure that exported identififiers do not refer to types, inline-procedures or constants. Signed-off-by: Peter Bex <peter@more-magic.net> diff --git a/NEWS b/NEWS index 84a65d48..d2708547 100644 --- a/NEWS +++ b/NEWS @@ -35,8 +35,9 @@ (fixes #1440, thanks to "megane"). - Module system - - Trying to export a foreign variable gives a friendly error instead - of saying the variable doesn't exist (partial fix for #1346). + - Trying to export a foreign variable, define-inlined procedure or + define-constant variable gives a friendly error instead of saying + the variable doesn't exist (fixes #1346). - Tools - The new "-module-registration" options causes module registration diff --git a/core.scm b/core.scm index 9bb08b42..388c8d97 100644 --- a/core.scm +++ b/core.scm @@ -1040,7 +1040,10 @@ (exit 1)) (##sys#finalize-module (##sys#current-module) - (map car foreign-variables))) + (lambda (id) + (and (not (assq id foreign-variables)) + (not (hash-table-ref inline-table id)) + (not (hash-table-ref constant-table id)))))) (let ((il (or (assq name import-libraries) all-import-libraries))) (when il (emit-import-lib name il) diff --git a/modules.scm b/modules.scm index aab5e6a5..e9abd786 100644 --- a/modules.scm +++ b/modules.scm @@ -446,8 +446,8 @@ (define ##sys#finalize-module (let ((display display) (write-char write-char)) - (lambda (mod #!optional (bad-exports '())) - ;; bad-exports: any list of symbols which should be rejected as invalid + (lambda (mod #!optional (check-export (lambda _ #t))) + ;; check-export: returns #f if given identifier names a non-exportable object (let* ((explist (module-export-list mod)) (name (module-name mod)) (dlist (module-defined-list mod)) @@ -470,9 +470,11 @@ (let* ((h (car xl)) (id (if (symbol? h) h (car h)))) (cond ((assq id sexports) (loop (cdr xl))) - ((memq id bad-exports) - (##sys#error "special identifier may not be exported" - id)) + ((not (check-export id)) + (set! missing #t) + (##sys#warn "exported identifier does not refer to value or syntax binding" + id) + (loop (cdr xl))) (else (cons (consTrap