From 5aa1cf02344af8548071107c963b5f1eb379884f Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 3 Oct 2019 13:07:28 +0200
Subject: [PATCH] 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 <address@hidden>
---
 NEWS        |  5 +++--
 core.scm    |  5 ++++-
 modules.scm | 12 +++++++-----
 3 files changed, 14 insertions(+), 8 deletions(-)

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 
-- 
2.20.1