[armedbear-cvs] r14449 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl

[mevenson at common-lisp.net]

Author: mevenson
Date: Wed Mar 27 07:07:05 2013
New Revision: 14449

Log:
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.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Package.java
   trunk/abcl/test/lisp/abcl/bugs.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Package.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Package.java	Wed Mar 27 03:29:58 2013	(r14448)
+++ trunk/abcl/src/org/armedbear/lisp/Package.java	Wed Mar 27 07:07:05 2013	(r14449)
@@ -560,28 +560,16 @@
     public synchronized void unexport(final Symbol symbol)
 
     {
-        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()));
+      }
     }
 
     public synchronized void shadow(final String symbolName)

Modified: trunk/abcl/test/lisp/abcl/bugs.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/bugs.lisp	Wed Mar 27 03:29:58 2013	(r14448)
+++ trunk/abcl/test/lisp/abcl/bugs.lisp	Wed Mar 27 07:07:05 2013	(r14449)
@@ -141,3 +141,21 @@
       '(a .?0))
   (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)
+
+