[armedbear-cvs] r14170 - in trunk/abcl: contrib/abcl-asdf contrib/jss contrib/mvn src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Mon Oct  8 11:06:57 2012
New Revision: 14170

Log:
Fix the broken require contracts in ABCL-CONTRIB.

CL:REQUIRE now calls PROVIDE with module names when successful (as
opposed to relying in the loaded code to do this explicity).

Modified:
   trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd
   trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp
   trunk/abcl/contrib/jss/jss.asd
   trunk/abcl/contrib/mvn/jna.asd
   trunk/abcl/src/org/armedbear/lisp/require.lisp

Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd	Mon Oct  8 11:06:55 2012	(r14169)
+++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd	Mon Oct  8 11:06:57 2012	(r14170)
@@ -1,7 +1,6 @@
 ;;;; -*- Mode: LISP -*-
-(in-package :asdf)
 
-(defsystem :abcl-asdf
+(asdf:defsystem :abcl-asdf
   :author "Mark Evenson"
   :version "0.8.0"
   :depends-on (jss)
@@ -18,7 +17,7 @@
                     :depends-on ("abcl-asdf" "asdf-jar")))
             :depends-on (packages))))
 
-(defsystem :abcl-asdf-test
+(asdf:defsystem :abcl-asdf-test
   :author "Mark Evenson"
   :depends-on (abcl-asdf)
   :components

Modified: trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp	Mon Oct  8 11:06:55 2012	(r14169)
+++ trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp	Mon Oct  8 11:06:57 2012	(r14170)
@@ -421,3 +421,6 @@
   (with-slots (asdf::group-id asdf::artifact-id asdf::version)
       (asdf:ensure-parsed-mvn mvn)
     (resolve-dependencies (format nil "~A:~A:~A" asdf::group-id asdf::artifact-id asdf::version))))
+
+;;; Currently the last file listed in ASDF
+(provide 'abcl-asdf)

Modified: trunk/abcl/contrib/jss/jss.asd
==============================================================================
--- trunk/abcl/contrib/jss/jss.asd	Mon Oct  8 11:06:55 2012	(r14169)
+++ trunk/abcl/contrib/jss/jss.asd	Mon Oct  8 11:06:57 2012	(r14170)
@@ -1,7 +1,5 @@
 ;;;; -*- Mode: LISP -*-
-(in-package :asdf)
-
-(defsystem :jss
+(asdf:defsystem :jss
   :author "Alan Ruttenberg, Mark Evenson"
   :version "3.0.3" 
   :components 

Modified: trunk/abcl/contrib/mvn/jna.asd
==============================================================================
--- trunk/abcl/contrib/mvn/jna.asd	Mon Oct  8 11:06:55 2012	(r14169)
+++ trunk/abcl/contrib/mvn/jna.asd	Mon Oct  8 11:06:57 2012	(r14170)
@@ -2,8 +2,7 @@
 
 ;;;; Need to have jna.jar present for CFFI to have a chance of working.
 ;;; XXX jna-3.4.0 seems much more capable, but doesn't have a resolvable pom.xml from Maven central
-(require :asdf)
 (asdf:defsystem :jna 
     :version "3.0.9"
-    :defsystem-depends-on (abcl-asdf) ;;; XXX not working in the bowels of ASDF
+    :defsystem-depends-on (abcl-asdf)
     :components ((:mvn "com.sun.jna/jna/3.0.9")))

Modified: trunk/abcl/src/org/armedbear/lisp/require.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/require.lisp	Mon Oct  8 11:06:55 2012	(r14169)
+++ trunk/abcl/src/org/armedbear/lisp/require.lisp	Mon Oct  8 11:06:57 2012	(r14170)
@@ -38,8 +38,10 @@
 
 (defun module-provide-system (module) 
   (let ((*readtable* (copy-readtable nil)))
-    (handler-case 
-        (load-system-file (string-downcase (string module)))
+    (handler-case
+        (progn 
+          (load-system-file (string-downcase (string module)))
+          (provide module))
       (t (e) 
         (unless (and (typep e 'error)
                      (search "Failed to find loadable system file"
@@ -57,11 +59,13 @@
       (cond (pathnames
              (unless (listp pathnames) (setf pathnames (list pathnames)))
              (dolist (x pathnames)
-               (load x)))
+               (load x))
+             (provide module-name))
             (t
-             (unless (some (lambda (p) (funcall p module-name))
+             (if (some (lambda (p) (funcall p module-name))
                            (append (list #'module-provide-system)
                                  sys::*module-provider-functions*))
-               (error "Don't know how to ~S ~A." 'require module-name))))
+                 (provide module-name) ;; Shouldn't hurt
+                 (error "Don't know how to ~S ~A." 'require module-name))))
       (set-difference *modules* saved-modules))))