~ chicken-core (chicken-5) 21ff0d6affb35f7184a5e78f9d4beccc869b47b2

commit 21ff0d6affb35f7184a5e78f9d4beccc869b47b2
Author:     felix <felix@p.callcc.org>
AuthorDate: Sun Aug 25 12:23:05 2019 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sat Sep 14 15:07:18 2019 +0200

    Disallow exporting variables defined with define-external
    
    When finalizing modules, explicitly check in compiled code whether
    the export refers to a variable defined with "define-external".
    Since such variables represent foreign memory, they do not follow Scheme
    semantics and any changes to them will not be reflected by an associated
    exported variable. Note that this is different for functions, these
    can not change spontaneously as compared to (say) a volatile external
    variable.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/NEWS b/NEWS
index e8cc6054..7d216375 100644
--- a/NEWS
+++ b/NEWS
@@ -31,6 +31,10 @@
   - Inline files no longer refer to unexported foreign stub functions
     (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).
+
 - Tools
   - The new "-module-registration" options causes module registration
     code to always be included in the program, even when it has also
diff --git a/core.scm b/core.scm
index bd36448b..9a51f04d 100644
--- a/core.scm
+++ b/core.scm
@@ -1019,7 +1019,9 @@
 						       ;; avoid backtrace
 						       (print-error-message ex (current-error-port))
 						       (exit 1))
-						   (##sys#finalize-module (##sys#current-module)))
+						   (##sys#finalize-module 
+                                                     (##sys#current-module)
+                                                     (map car foreign-variables)))
 						 (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 6bbae798..aab5e6a5 100644
--- a/modules.scm
+++ b/modules.scm
@@ -446,7 +446,8 @@
 (define ##sys#finalize-module 
   (let ((display display)
 	(write-char write-char))
-    (lambda (mod)
+    (lambda (mod #!optional (bad-exports '())) 
+      ;; bad-exports: any list of symbols which should be rejected as invalid
       (let* ((explist (module-export-list mod))
 	     (name (module-name mod))
 	     (dlist (module-defined-list mod))
@@ -468,30 +469,33 @@
 		    '()
 		    (let* ((h (car xl))
 			   (id (if (symbol? h) h (car h))))
-		      (if (assq id sexports) 
-			  (loop (cdr xl))
-			  (cons 
-			   (cons 
-			    id
-			    (let ((def (assq id dlist)))
-			      (if (and def (symbol? (cdr def))) 
-				  (cdr def)
-				  (let ((a (assq id (##sys#current-environment))))
-				    (cond ((and a (symbol? (cdr a))) 
-					   (dm "reexporting: " id " -> " (cdr a))
-					   (cdr a)) 
-					  ((not def)
-					   (set! missing #t)
-					   (##sys#warn 
-					    (string-append 
-					     "exported identifier of module `" 
-					     (symbol->string name)
-					     "' has not been defined")
-					    id)
-					   #f)
-					  (else (module-rename id name)))))))
-			   (loop (cdr xl)))))))))
-	(for-each
+		      (cond ((assq id sexports) (loop (cdr xl)))
+                            ((memq id bad-exports)
+                             (##sys#error "special identifier may not be exported"
+                                          id))
+                            (else 
+                              (cons 
+                                (cons 
+			          id
+                                  (let ((def (assq id dlist)))
+                                    (if (and def (symbol? (cdr def))) 
+                                        (cdr def)
+                                        (let ((a (assq id (##sys#current-environment))))
+                                          (cond ((and a (symbol? (cdr a))) 
+                                                 (dm "reexporting: " id " -> " (cdr a))
+                                                 (cdr a)) 
+                                                ((not def)
+                                                 (set! missing #t)
+                                                 (##sys#warn 
+                                                   (string-append 
+					           "exported identifier of module `" 
+					           (symbol->string name)
+					           "' has not been defined")
+					           id)
+                                                 #f)
+                                                (else (module-rename id name)))))))
+                              (loop (cdr xl))))))))))
+        (for-each
 	 (lambda (u)
 	   (let* ((where (cdr u))
 		  (u (car u)))