Changeset 11299

Timestamp:

08/31/08 20:19:05 (15 years ago)

Author:

ehuelsmann

Message:

Fix DEFPACKAGE.24 and DEFPACKAGE.25 ansi-tests.

We're now at 58 failing tests.

Location:

trunk/j/src/org/armedbear/lisp

Files:

• Autoload.java (modified) (1 diff)
• defpackage.lisp (modified) (2 diffs)
• package.lisp (modified) (1 diff)

trunk/j/src/org/armedbear/lisp/Autoload.java

@@ -377 +377 @@
         autoload("hash-table-test", "HashTableFunctions");
         autoload("hash-table-test", "HashTableFunctions");
-        autoload("import", "PackageFunctions");
+        autoload("%import", "PackageFunctions");
         autoload("input-stream-p", "input_stream_p");
         autoload("integer-decode-float", "FloatFunctions");

trunk/j/src/org/armedbear/lisp/defpackage.lisp

@@ -47 +47 @@
                      :format-arguments
                      (list key1 key2 common)))))))))
+
+(defun ensure-available-symbols (symbols)
+   symbols)
 
 (defmacro defpackage (package &rest options)
@@ -119 +122 @@
           ,@(apply #'append (mapcar #'rest shadowing-imports))))
     `(%defpackage ,(string package) ',nicknames ',size
-                  ',shadows ',shadowing-imports ',(if use-p use nil)
-                  ',imports ',interns ',exports ',doc)))
+                  ',shadows (ensure-available-symbols ',shadowing-imports)
+                  ',(if use-p use nil)
+                  (ensure-available-symbols ',imports) ',interns ',exports ',doc)))

trunk/j/src/org/armedbear/lisp/package.lisp

@@ -35 +35 @@
       (return-from make-package (find-package name)))))
 
+;; Redefines function from defpackage.lisp, because there it's lacking restart-case
+
+(defun ensure-available-symbols (imports)
+  (remove nil
+          (mapcar #'(lambda (package-and-symbols)
+                      (let* ((package (find-package (designated-package-name (car package-and-symbols))))
+                             (new-symbols
+                              (remove nil
+                                      (mapcar #'(lambda (sym)
+                                                  (restart-case
+                                                      (progn
+                                                        (unless (find-symbol sym package)
+                                                          (error 'package-error
+                                                                 "The symbol ~A is not present in package ~A." sym (package-name package)))
+                                                        sym)
+                                                    (skip ()
+                                                      :report "Skip this symbol."
+                                                      nil)))
+                                              (cdr package-and-symbols)))))
+                        (when new-symbols
+                          (cons package new-symbols))))
+                  imports)))
+
+
+
+
 (defun import (symbols &optional (package *package* package-supplied-p))
   (dolist (symbol (if (listp symbols) symbols (list symbols)))