Commit 594b9e06 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

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.
parent 0999c0db
......@@ -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")))))
......
......@@ -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)
......
......@@ -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
......
;; -*- 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>.
......
......@@ -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))))
......@@ -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)
......
......@@ -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)
......
......@@ -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")
(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")) before))
(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")) before)))))
(assert (>= (file-write-date (asdf:compile-file-pathname* "file3")) file3-date))))
(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)))
......@@ -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."))))
......@@ -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))
......
;;; -*- 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))))))
......@@ -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)))))
;;; -*- Lisp -*-
(asdf:defsystem :wild-module
:version "0.0"
:components ((:wild-module "systems" :pathname #p"*.asd")))
......@@ -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))
......@@ -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)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment