Changeset 14296

Timestamp:

12/06/12 09:23:15 (8 years ago)

Author:

Mark Evenson

Message:

Constrain the logic for when CL:REQUIRE pushes symbols to CL:*MODULES*.

A REQUIRE of ABCL-CONTRIB for an instance of the implementation that
cannot locate the contrib binary artifact as being in the same
directory as the location of the ABCL system jar by
SYS:FIND-SYSTEM-JAR now raises an error.

Fixes #275.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• abcl-contrib.lisp (modified) (3 diffs)
• require.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp

@@ -3 +3 @@
 (require :asdf)
 
-;;; TODO possibly allow customization in system.lisp?
 (defun find-system-jar () 
+  "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p-something.jar`."
   (flet ((match-system-jar (p)
-           "Match `abcl.jar` or `abcl-1.0.1.jar` or `abcl-1.0.1-something.jar`"
            (and (pathnamep p)
                 (equal (pathname-type p) "jar")
@@ -28 +27 @@
 
 (defun find-contrib (&key (verbose nil))
-"Attempt to find the ABCL contrib jar and add its contents to ASDF."
+  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
+Returns the pathname of the contrib if it can be found."
   (unless *abcl-contrib*
     (unless *abcl-jar*
@@ -51 +51 @@
                     (format verbose "~&Added ~A to ASDF.~&" asdf-directory))))
               *abcl-contrib*)
-        (format verbose "Failed to find abcl-contrib at '~A'." abcl-contrib))))))
+            (error "Failed to find abcl-contrib at '~A'." abcl-contrib))))))
 
 (when (find-contrib :verbose t)

trunk/abcl/src/org/armedbear/lisp/require.lisp

@@ -57 +57 @@
   (unless (member (string module-name) *modules* :test #'string=)
     (let ((saved-modules (copy-list *modules*)))
-      (cond (pathnames
-             (unless (listp pathnames) (setf pathnames (list pathnames)))
-             (dolist (x pathnames)
-               (load x))
-             (provide module-name))
-            (t
-             (if (some (lambda (p) (funcall p module-name))
+      (cond                
+;;; Since these are files packaged with the system we ensure that
+;;; PROVIDE has been called unless the module has other dependencies
+;;; that must be satisfied to be loaded, which is currently only the
+;;; case with 'abcl-contrib'.
+        (pathnames
+         (unless (listp pathnames) (setf pathnames (list pathnames)))
+         (dolist (x pathnames)
+           (load x))
+         (unless (string-equal module-name "abcl-contrib")
+           (provide module-name)))
+;;; Responsibility for actually calling PROVIDE up to module provider
+;;; function
+        (t
+         (unless (some (lambda (p) (funcall p module-name))
                            (append (list #'module-provide-system)
-                                 sys::*module-provider-functions*))
-                 (provide module-name) ;; Shouldn't hurt
-                 (error "Don't know how to ~S ~A." 'require module-name))))
+                                   sys::*module-provider-functions*))
+               (error "Don't know how to ~S ~A." 'require module-name))))
       (set-difference *modules* saved-modules))))