On Thu, Oct 03, 2019 at 01:11:31PM +0200, felix.winkelm...@bevuta.com wrote:
> This patch extends 21ff0d6affb35f7184a5e78f9d4beccc869b47b2 to
> type-names, inline procedures and constants, giving a warning when
> an identifier naming such an entity is exported.

I think the types should be excluded from this check because those are
in a completely different namespace:

(module foo (x)
  (import scheme (chicken base) (chicken type))
  (define x 2)
  (define-type x float)
  (print x))

(import foo)
(print x)

The program above works fine before this patch but not with it.
If you put define-constant or define-inline at the place of the
define-type, the program will also work but the output of the
print calls will be inconsistent.  Only with types the result
is consistent, and I think it isn't wrong to allow this, given
that types aren't first-class Scheme objects.

So, I'd suggest the attached patch instead.  I've also updated NEWS
to mention the other types we check and remove the comment that the
fix is partial.

Cheers,
Peter
From 5aa1cf02344af8548071107c963b5f1eb379884f Mon Sep 17 00:00:00 2001
From: felix <fe...@call-with-current-continuation.org>
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 <pe...@more-magic.net>
---
 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

Attachment: signature.asc
Description: PGP signature

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to