From 594b9e06c23759debb87f18a4ce52c510379d78e Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Thu, 10 Jan 2013 23:08:06 -0500 Subject: [PATCH] 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. --- asdf.asd | 2 +- compatibility.lisp | 3 +- .../wild-modules.lisp | 0 debian/changelog | 29 ++++++++--- header.lisp | 2 +- package.lisp | 16 +++--- pathname.lisp | 3 +- test/script-support.lisp | 12 +++++ test/test-module-depend.script | 29 ++++++----- test/test-module-excessive-depend.asd | 34 ------------- test/test-module-excessive-depend.script | 50 +++++++++++++++---- test/test-touch-system-1.script | 2 +- test/test-touch-system-2.script | 13 +++-- test/test1.script | 25 ++++++---- test/wild-module.asd | 5 -- test/wild-module.script | 5 +- upgrade.lisp | 2 +- 17 files changed, 130 insertions(+), 102 deletions(-) rename wild-modules.lisp => contrib/wild-modules.lisp (100%) delete mode 100644 test/test-module-excessive-depend.asd delete mode 100644 test/wild-module.asd diff --git a/asdf.asd b/asdf.asd index c4ad32c7..83e5a62d 100644 --- 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 8317cf06..730ff407 100644 --- 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 977a7d44..d87e4bcc 100644 --- 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 769a30c5..82e7703c 100644 --- 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 44dd9487..71617f2f 100644 --- 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 7228ba67..601fda3b 100644 --- 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 6d92ce92..4cdfd732 100644 --- 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 4506bb47..36f90fab 100644 --- 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 index 9640cba4..00000000 --- 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 505b71a8..ad8136e6 100644 --- 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 3785ee9e..70d5b490 100644 --- 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 a922afcc..6e5ac5ec 100644 --- 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 5354db53..8f8dae25 100644 --- 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 index 8baf5233..00000000 --- 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 3f38ac4a..f2a0f352 100644 --- 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 dbeb5043..0c41f343 100644 --- 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))) -- GitLab