2.26.72: fix more package issues found with ECL and GCL.

Also, move wild-modules to a contrib/ directory.
Refactor tests somewhat, introducing a function touch-file.

diff --git a/asdf.asd b/asdf.asd
index c4ad32c..83e5a62 100644 (file)
--- a/asdf.asd
+++ b/asdf.asd
@@ -15,7 +15,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.71" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.72" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components ((:module "build" :components ((:file "asdf")))))
 

diff --git a/compatibility.lisp b/compatibility.lisp
index 8317cf0..730ff40 100644 (file)
--- a/compatibility.lisp
+++ b/compatibility.lisp
@@ -93,7 +93,8 @@
   (defmacro print-unreadable-object ((object stream &key type identity) &body body)
     `(%print-unreadable-object ,object ,stream ,type ,identity (lambda () ,@body)))
   (defun ensure-directories-exist (path)
-    (run-shell-command "mkdir -p ~S" (namestring (pathname-directory-pathname path)))))
+    (lisp:system (format nil "mkdir -p ~S"
+                         (namestring (make-pathname :name nil :type nil :version nil :defaults path))))))
 
 #+genera
 (unless (fboundp 'ensure-directories-exist)

diff --git a/wild-modules.lisp b/contrib/wild-modules.lisp
similarity index 100%
rename from wild-modules.lisp
rename to contrib/wild-modules.lisp

diff --git a/debian/changelog b/debian/changelog
index 977a7d4..d87e4bc 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -55,12 +55,6 @@ cl-asdf (2:2.27-1) unstable; urgency=low
     builtin systems (such as SB-BSD-SOCKETS on SBCL) cannot be forced
     (which doesn't work on SBCL).
 
-  * Internals have been refactored, and some sorry features were excised.
-    The semantics of OPERATION-DONE-P is simplified and now well-specified.
-    FIND-COMPONENT will pass component objects through, and
-    a corresponding FIND-OPERATION replaces MAKE-SUB-OPERATION.
-    Several internal accessors were renamed.
-
   * IF-FEATURE is a new attribute of components that accepts an arbitrary
     feature expression such as (:and :sbcl (:or :x86 :x86-64)),
     which when defined is a precondition to the component being enabled;
@@ -82,6 +76,27 @@ cl-asdf (2:2.27-1) unstable; urgency=low
     this massively updated ASDF and its new features with #+asdf2.27.
     This is *not* ASDF3, for we painfully maintained backwards compatibility.
 
+  * CONCATENATE-SOURCE-OP is a new operation that builds a single Lisp file
+    from all the source files in a system,
+    which allows you to develop in a structured way with many compact files,
+    yet deliver a large single file. Other related operations allow you
+    to load that source file, or compile and load it,
+    or do the same while including all other system dependencies.
+    ASDF was broken up into lots of small files, to be delivered that way.
+
+  * Packages were introduced as ASDF was broken up into small files.
+    Each file now has its own package, importing and exporting functionality,
+    following the style made popular by faslpath and quick-build.
+    A macro DEFINE-PACKAGE was defined in replacement to DEFPACKAGE
+    to manage the same effects while making every effort to
+    Do The Right Thing(tm) in case of hot upgrade.
+
+  * Internals have been refactored, and some sorry features were excised.
+    The semantics of OPERATION-DONE-P is simplified and now well-specified.
+    FIND-COMPONENT will pass component objects through, and
+    a corresponding FIND-OPERATION replaces MAKE-SUB-OPERATION.
+    Several internal accessors were renamed.
+
   * Portability updates were done for
     ABCL, CLISP, CMUCL, ECL, LispWorks Personal Edition, MKCL, XCL.
     Working support for GCL 2.6 was restored, with notable limitations
@@ -111,7 +126,7 @@ cl-asdf (2:2.27-1) unstable; urgency=low
     (defparameter *upgrade-asdf-p* t)
     (pushnew 'try-compile-file-with-asdf *compile-file-for-emacs-hook*)
 
- -- Francois-Rene Rideau <fare@tunes.org>  Thu, 27 Dec 2012 15:59:44 -0500
+ -- Francois-Rene Rideau <fare@tunes.org>  Thu, 10 Jan 2012 22:59:44 -0500
 
 cl-asdf (2:2.26-1) unstable; urgency=low
 

diff --git a/header.lisp b/header.lisp
index 769a30c..82e7703 100644 (file)
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.71: Another System Definition Facility.
+;;; This is ASDF 2.26.72: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.

diff --git a/package.lisp b/package.lisp
index 44dd948..71617f2 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -19,13 +19,13 @@
 
 (in-package :asdf/package)
 
-(declaim (optimize (speed 0) (safety 3) (debug 3)))
+(declaim (optimize (speed 0) (safety 3) #-gcl (debug 3)))
 
 (defmacro DBG (tag &rest exprs)
   "simple debug statement macro:
 outputs a tag plus a list of variable and their values, returns the last value"
   ;;"if not in debugging mode, just compute and return last value"
-  #-DBGXXX (declare (ignore tag)) #-DBGXXX (car (last exprs)) #+DBGXXX
+  ;; #-DBGXXX (declare (ignore tag)) #-DBGXXX (car (last exprs)) #+DBGXXX
   (let ((res (gensym))(f (gensym)))
   `(let (,res (*print-readably* nil))
     (flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args)))
@@ -171,7 +171,7 @@ when the symbol is not found."
   (defun ensure-package-fmakunbound-setf (package symbols)
     (loop :for name :in symbols
           :for sym = (find-symbol* name package nil)
-          :when sym :do #-gcl (fmakunbound `(setf ,sym))))
+          :when sym :do (progn #-gcl (fmakunbound `(setf ,sym)))))
   (defun packages-from-names (names)
     (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t))
   (defun ensure-package (name &key
@@ -240,6 +240,7 @@ when the symbol is not found."
                     (ipn (gethash name inherited)))
                (multiple-value-bind (x xp) (find-symbol name package)
                  (cond
+                   ((gethash name shadowed))
                    (ipn
                     (unless (eq spn ipn)
                       (error "Can't inherit ~S from ~S, it is inherited from ~S"
@@ -248,8 +249,6 @@ when the symbol is not found."
                     (unless (eq symbol x)
                       (error "Can't inherit ~S from ~S, it is imported from ~S"
                              name sp (package-name (symbol-package x)))))
-                   ((gethash name shadowed)
-                    (error "Can't inherit ~S from ~S, it is shadowed" name spn))
                    (t
                     (setf (gethash name inherited) spn)
                     (when xp
@@ -294,12 +293,12 @@ when the symbol is not found."
                      (when (eq ustat :external)
                        (ensure-exported name sym u))))))))
         (assert (soft-upgrade-p upgrade))
-        (setf (documentation package t) documentation)
+        #-gcl (setf (documentation package t) documentation) #+gcl documentation
         (loop :for p :in discarded
               :for n = (remove-if #'(lambda (x) (member x names :test 'equal))
                                   (package-names p))
-              :do (if n (rename-package discarded (first n) (rest n))
-                      (delete-package* discarded)))
+              :do (if n (rename-package p (first n) (rest n))
+                      (delete-package* p)))
         (rename-package package name nicknames)
         (loop :for p :in (set-difference (package-use-list package) (append mix use))
               :do (unuse-package p package))
@@ -389,3 +388,4 @@ when the symbol is not found."
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      #+(or ecl gcl) (defpackage ,package (:use))
      (apply 'ensure-package ',(parse-define-package-form package clauses))))
+

diff --git a/pathname.lisp b/pathname.lisp
index 7228ba6..601fda3 100644 (file)
--- a/pathname.lisp
+++ b/pathname.lisp
@@ -4,8 +4,8 @@
 (asdf/package:define-package :asdf/pathname
   (:recycle :asdf/pathname :asdf)
   (:fmakunbound #:translate-pathname*)
-  (:use :common-lisp :asdf/utility)
   #+gcl<2.7 (:shadowing-import-from :system :*load-pathname*) ;; GCL 2.6 sucks
+  (:use :common-lisp :asdf/utility)
   (:export
    #:*resolve-symlinks*
    ;; Making and merging pathnames, portably
@@ -60,7 +60,6 @@
 
 Defaults to T.")
 
-
 ;;; The hell of portably making and merging pathnames!
 
 (defun* normalize-pathname-directory-component (directory)

diff --git a/test/script-support.lisp b/test/script-support.lisp
index 6d92ce9..4cdfd73 100644 (file)
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -76,9 +76,21 @@
   (eval `(trace ,@(loop :for s :in *debug-symbols* :collect (find-symbol (string s) :asdf))))
   (funcall (find-symbol (string :initialize-source-registry) :asdf)
            `(:source-registry :ignore-inherited-configuration))
+  (funcall (find-symbol (string :initialize-output-translations) :asdf)
+           `(:output-translations
+             (,*test-directory* (,*asdf-directory* "build/fasls" :implementation "test"))
+             (t (,*asdf-directory* "build/fasls" :implementation "root"))
+             :ignore-inherited-configuration))
   (let ((registry (find-symbol (string :*central-registry*) :asdf)))
     (set registry `(,*asdf-directory* ,*test-directory*))))
 
+(defun touch-file (file &key (offset 0) timestamp)
+  (let ((timestamp (or timestamp (+ offset (get-universal-time)))))
+    (multiple-value-bind (sec min hr day month year) (decode-universal-time timestamp)
+      (funcall (find-symbol (string :run-shell-command) :asdf)
+               "touch -t ~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D ~S"
+               year month day hr min sec (namestring file)))))
+
 (defun load-asdf ()
   (load *asdf-fasl*)
   (use-package :asdf :asdf-test)

diff --git a/test/test-module-depend.script b/test/test-module-depend.script
index 4506bb4..36f90fa 100644 (file)
--- a/test/test-module-depend.script
+++ b/test/test-module-depend.script
@@ -7,21 +7,26 @@
  (asdf:load-system 'test-module-depend)
 
  ;; test that it compiled
- (let ((file1-date (file-write-date (asdf:compile-file-pathname* "file1"))))
+ (let* ((file1.fasl (asdf:compile-file-pathname* "file1"))
+        (file2.fasl (asdf:compile-file-pathname* "file2"))
+        (file3.fasl (asdf:compile-file-pathname* "file3"))
+        (file1-date (file-write-date file1.fasl))
+        (file3-date (file-write-date file3.fasl)))
 
-   (assert (and file1-date (file-write-date (asdf:compile-file-pathname* "file2"))))
+   (assert (and file1-date file3-date))
 
    ;; and loaded
    (assert (eval (intern (symbol-name '#:*file1*) :test-package)))
 
-   ;; now touch file1 and check that file2 _is_ also recompiled
-   ;; this will only work if the cross-module (intra-system)
-   ;; dependency bug is fixed.
+   ;; now touch file1 and its fasl so the fasl is out of date,
+   ;; and check that file2 _is_ also recompiled
+   ;; this didn't work before the cross-module (intra-system) dependency bug was fixed.
 
-   (let ((before (file-write-date (asdf:compile-file-pathname* "file2"))))
-     (sleep 1)
-     (asdf::run-shell-command "touch file1.lisp")
-     (asdf:operate 'asdf:load-op 'test-module-depend)
-     (assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before))
-     ;; does this properly go to the second level?
-     (assert (> (file-write-date (asdf:compile-file-pathname* "file3")) before)))))
+   (touch-file "file1.lisp" :timestamp (- file3-date 60))
+   (touch-file file1.fasl :timestamp (- file3-date 90))
+   (touch-file file2.fasl :timestamp (- file3-date 30))
+   (touch-file file3.fasl :timestamp (- file3-date 15))
+   (asdf:operate 'asdf:load-op 'test-module-depend)
+   (assert (>= (file-write-date (asdf:compile-file-pathname* "file2")) file3-date))
+   ;; does this properly go to the second level?
+   (assert (>= (file-write-date (asdf:compile-file-pathname* "file3")) file3-date))))

diff --git a/test/test-module-excessive-depend.asd b/test/test-module-excessive-depend.asd
deleted file mode 100644 (file)
index 9640cba..0000000
--- a/test/test-module-excessive-depend.asd
+++ /dev/null
@@ -1,34 +0,0 @@
-(defpackage :tmed-asd
-    (:use #:asdf :common-lisp))
-
-(in-package :tmed-asd)
-
-(defsystem :test-module-excessive-depend
-    :components ((:file "file1")
-                 (:module "quux"
-                          :pathname ""
-                          :depends-on ("file1")
-                          :components ((:file "file2")))))
-
-(defun find-quux ()
-  (find-component :test-module-excessive-depend "quux"))
-
-(defun find-file2 ()
-  (find-component (find-quux) "file2"))
-
-(defmethod component-depends-on ((op load-op)
-                                 (c (eql (find-file2))))
-  (cons '(load-op "file3-only")
-        (call-next-method)))
-
-(defmethod component-depends-on ((op compile-op)
-                                 (c (eql (find-file2))))
-  (cons '(load-op "file3-only")
-        (call-next-method)))
-
-(defmethod find-component :around ((m (eql (find-quux)))
-                                   (c string))
-  "FIND-COMPONENT on a component is a no-op --- it's already found."
-  (if (string-equal c "file3-only")
-      (asdf:find-system c)
-      (call-next-method)))

diff --git a/test/test-module-excessive-depend.script b/test/test-module-excessive-depend.script
index 505b71a..ad8136e 100644 (file)
--- a/test/test-module-excessive-depend.script
+++ b/test/test-module-excessive-depend.script
@@ -15,13 +15,39 @@
 ;;;---------------------------------------------------------------------------
 
 (quit-on-error
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
+
+ (defsystem :test-module-excessive-depend
+   :components ((:file "file1")
+                (:module "quux"
+                 :pathname ""
+                 :depends-on ("file1")
+                 :components ((:file "file2")))))
+
+ (defun find-quux ()
+   (find-component :test-module-excessive-depend "quux"))
+
+ (defun find-file2 ()
+   (find-component (find-quux) "file2"))
+
+ (defmethod component-depends-on ((op load-op)
+                                  (c (eql (find-file2))))
+   (cons `(load-op ,(find-system "file3-only"))
+         (call-next-method)))
+
+ (defmethod component-depends-on ((op compile-op)
+                                  (c (eql (find-file2))))
+   (cons `(load-op ,(find-system "file3-only"))
+         (call-next-method)))
+
  (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
 
  ;; test that it compiled
- (let ((file1-date (file-write-date (asdf:compile-file-pathname* "file1")))
-       (file2-date (file-write-date (asdf:compile-file-pathname* "file2")))
-       (file3-date (file-write-date (asdf:compile-file-pathname* "file3"))))
+ (let* ((file1 (asdf:compile-file-pathname* "file1"))
+        (file2 (asdf:compile-file-pathname* "file2"))
+        (file3 (asdf:compile-file-pathname* "file3"))
+        (file1-date (file-write-date file1))
+        (file2-date (file-write-date file2))
+        (file3-date (file-write-date file3)))
    (unless (and file1-date file2-date file3-date)
      (error "Failed to compile one of the three files ~
             that should be compiled for this test: ~{~a~}"
@@ -40,9 +66,12 @@
    ;; this will only work if the cross-module (intra-system)
    ;; dependency bug is fixed and the excessive compilation bug is fixed.
 
-   (let ((before file2-date))
-     (sleep 1)
-     (asdf::run-shell-command "touch file1.lisp")
+   (let ((before file3-date))
+     (touch-file "file1.lisp" :timestamp (- before 60))
+     (touch-file file1 :timestamp (- before 90))
+     (touch-file "file2.lisp" :timestamp (- before 30))
+     (touch-file file2 :timestamp (- before 15))
+
      (let ((plan (asdf::traverse
                   (make-instance 'asdf:load-op)
                   (asdf:find-system 'test-module-excessive-depend)))
@@ -51,9 +80,8 @@
        (when (loop :for (o . c) :in plan :thereis (and (eq c file3) (typep o 'asdf:compile-op)))
          (error "Excessive operations on file3-only system.  Bad propagation of dependencies.")))
      (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
-     (assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before))
-     (assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before))
-     )
-   (unless (= (file-write-date (asdf:compile-file-pathname* "file3"))
+     (assert (>= (file-write-date file1) before))
+     (assert (>= (file-write-date file2) before)))
+   (unless (= (file-write-date file3)
               file3-date)
      (error "Excessive compilation of file3.lisp:  traverse bug."))))

diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script
index 3785ee9..70d5b49 100644 (file)
--- a/test/test-touch-system-1.script
+++ b/test/test-touch-system-1.script
@@ -17,7 +17,7 @@
      (assert date1)
      (assert file)
      (sleep 1)
-     (asdf:run-shell-command "touch ~a" file)
+     (touch-file file)
      (asdf:find-system :test1)
      (let ((date2 (system-load-time :test1)))
        (print (list date1 date2))

diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script
index a922afc..6e5ac5e 100644 (file)
--- a/test/test-touch-system-2.script
+++ b/test/test-touch-system-2.script
@@ -1,6 +1,6 @@
 ;;; -*- Lisp -*-
 
-;;; test system def reloading if touched
+;;; test system definition reloading if touched
 ;;; system that canNOT be found using *system-definition-search-functions*
 
 (load "script-support.lisp")
@@ -11,16 +11,15 @@
             (when data
               (car data)))))
    (setf asdf:*central-registry* nil)
-   (load (merge-pathnames "test1.asd"))
-   (assert (asdf:find-system :test1))
+   (load "test1.asd")
+   (assert (find-system :test1))
    (let ((date1 (system-load-time :test1))
-         (file (namestring (merge-pathnames "test1.asd"))))
+         (file "test1.asd"))
      (assert date1)
      (assert file)
-     (sleep 1)
-     (asdf:run-shell-command "touch ~a" file)
+     (sleep 2)
+     (touch-file file)
      (asdf:find-system :test1)
      (let ((date2 (system-load-time :test1)))
        (assert date2)
        (assert (> date2 date1))))))
-

diff --git a/test/test1.script b/test/test1.script
index 5354db5..8f8dae2 100644 (file)
--- a/test/test1.script
+++ b/test/test1.script
@@ -3,8 +3,9 @@
 (load-asdf)
 
 (quit-on-error
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (DBG "loading test1")
+ (touch-file "file1.lisp" :offset -600) ;; touch file1.lisp 10 minutes ago.
+ (touch-file "file2.lisp" :offset -300) ;; touch file2.lisp 5 minutes ago.
  (asdf:load-system 'test1)
  (let* ((file1 (asdf:compile-file-pathname* "file1"))
         (file2 (asdf:compile-file-pathname* "file2"))
@@ -18,20 +19,24 @@
    (DBG "and loaded")
    (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
 
-   (DBG "now remove file2 that depends-on file1 check that file1 is _not_ recompiled, but file2 is")
+   (DBG "now remove file2 that depends-on file1" file1-date (- file1-date 120))
+   (touch-file file1 :timestamp (- file1-date 120)) ;; move file1.fasl two minutes ago.
+   (assert-equal (- file1-date 120) (file-write-date file1))
    (asdf::delete-file-if-exists file2)
-   ;; filesystem mtime has 1 second granularity. Make sure even fast machines see a difference.
-   (sleep 1.5)
+
+   (asdf:clear-system 'test1)
    (asdf:load-system 'test1)
-   (assert (= file1-date (file-write-date file1)))
-   (assert (< file2-date (file-write-date file2)))
+   (DBG "check that file1 is _not_ recompiled, but file2 is" (file-write-date file1))
+   (assert-equal (- file1-date 120) (file-write-date file1))
+   (assert (<= file2-date (file-write-date file2)))
 
    (DBG "now touch file1 and check that file2 _is_ also recompiled")
    ;; XXX run-shell-command loses if *default-pathname-defaults* is not the
    ;; unix cwd.  this is not a problem for run-tests.sh, but can be in general
    (let ((before (file-write-date file2)))
-     ;; filesystem mtime has 1 second granularity. Make sure even fast machines see a difference.
-     (sleep 1)
-     (asdf::run-shell-command "touch file1.lisp")
+     (touch-file "file1.lisp" :offset -60) ;; touch file1 a minute ago.
+     (touch-file file2 :timestamp (- before 10)) ;; touch file2.fasl ten seconds before.
+     (asdf:clear-system 'test1)     (asdf:clear-system 'test1)
      (asdf:operate 'asdf:load-op 'test1)
-     (assert (> (file-write-date file2) before)))))
+     (DBG :foo (file-write-date file2) before)
+     (assert (>= (file-write-date file2) before)))))

diff --git a/test/wild-module.asd b/test/wild-module.asd
deleted file mode 100644 (file)
index 8baf523..0000000
--- a/test/wild-module.asd
+++ /dev/null
@@ -1,5 +0,0 @@
-;;; -*- Lisp -*-
-
-(asdf:defsystem :wild-module
-  :version "0.0"
-  :components ((:wild-module "systems" :pathname #p"*.asd")))

diff --git a/test/wild-module.script b/test/wild-module.script
index 3f38ac4..f2a0f35 100644 (file)
--- a/test/wild-module.script
+++ b/test/wild-module.script
@@ -2,5 +2,8 @@
 (load "script-support.lisp")
 (load-asdf)
 (quit-on-error
- (load (asdf:system-relative-pathname :asdf "wild-modules.lisp"))
+ (load (asdf:system-relative-pathname :asdf "contrib/wild-modules.lisp"))
+ (asdf:defsystem :wild-module
+   :version "0.0"
+   :components ((:wild-module "systems" :pathname #p"*.asd")))
  (load-system :wild-module))

diff --git a/upgrade.lisp b/upgrade.lisp
index dbeb504..0c41f34 100644 (file)
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -31,7 +31,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.71")
+         (asdf-version "2.26.72")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))