~ 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
(cons
Trap