Changeset 14449

Timestamp:

03/27/13 14:07:05 (12 years ago)

Author:

Mark Evenson

Message:

Fix UNEXPORT to work on symbols from foreign packages.

No longer check that the symbols which are the target of UNEXPORT are
accessible. Such symbols may be present in a foreign package as they
may have been part of a USE clause for which the original symbol has
subsequently made internal in its home package by a previous UNEXPORT
operation.

Fixes #311.

Location:

trunk/abcl

Files:

• src/org/armedbear/lisp/Package.java (modified) (1 diff)
• test/lisp/abcl/bugs.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/Package.java ¶

@@ -561 +561 @@
 
     {
-        if (symbol.getPackage() == this) {
-            if (externalSymbols.get(symbol.name.toString()) == symbol) {
-                externalSymbols.remove(symbol.name.toString());
-                internalSymbols.put(symbol.name.toString(), symbol);
-            }
-        } else {
-            // Signal an error if symbol is not accessible.
-            if (useList instanceof Cons) {
-                LispObject usedPackages = useList;
-                while (usedPackages != NIL) {
-                    Package pkg = (Package) usedPackages.car();
-                    if (pkg.findExternalSymbol(symbol.name) == symbol)
-                        return; // OK.
-                    usedPackages = usedPackages.cdr();
-                }
-            }
-            StringBuilder sb = new StringBuilder("The symbol ");
-            sb.append(symbol.getQualifiedName());
-            sb.append(" is not accessible in package ");
-            sb.append(name);
-            error(new PackageError(sb.toString()));
-        }
+      if (externalSymbols.get(symbol.name.toString()) == symbol) {
+        externalSymbols.remove(symbol.name.toString());
+        internalSymbols.put(symbol.name.toString(), symbol);
+      } else if (!(internalSymbols.get(symbol.name.toString()) == symbol)) {
+        StringBuilder sb = new StringBuilder("The symbol ");
+        sb.append(symbol.getQualifiedName());
+        sb.append(" is not accessible in package ");
+        sb.append(name);
+        error(new PackageError(sb.toString()));
+      }
     }
 

trunk/abcl/test/lisp/abcl/bugs.lisp ¶

@@ -142 +142 @@
   (A . #\Null))
       
+;;; http://trac.common-lisp.net/armedbear/ticket/311
+(deftest bugs.export.1
+   (let ((a (symbol-name (gensym "PACKAGE-")))
+         (b (symbol-name (gensym "PACKAGE-")))
+         result)
+     (make-package a)
+     (intern "FOO" a)
+     (export (find-symbol "FOO" a) a)
+     (make-package b :use (list a))
+     (export (find-symbol "FOO" b) b)
+     (unexport (find-symbol "FOO" a) a)
+     (setf result (unexport (find-symbol "FOO" b) b))
+     (delete-package a)
+     (delete-package b)
+     result)
+  t)
+
+