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 @@ ...@@ -15,7 +15,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :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 () :depends-on ()
:components ((:module "build" :components ((:file "asdf"))))) :components ((:module "build" :components ((:file "asdf")))))
......
...@@ -93,7 +93,8 @@ ...@@ -93,7 +93,8 @@
(defmacro print-unreadable-object ((object stream &key type identity) &body body) (defmacro print-unreadable-object ((object stream &key type identity) &body body)
`(%print-unreadable-object ,object ,stream ,type ,identity (lambda () ,@body))) `(%print-unreadable-object ,object ,stream ,type ,identity (lambda () ,@body)))
(defun ensure-directories-exist (path) (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 #+genera
(unless (fboundp 'ensure-directories-exist) (unless (fboundp 'ensure-directories-exist)
......
...@@ -55,12 +55,6 @@ cl-asdf (2:2.27-1) unstable; urgency=low ...@@ -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 builtin systems (such as SB-BSD-SOCKETS on SBCL) cannot be forced
(which doesn't work on SBCL). (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 * IF-FEATURE is a new attribute of components that accepts an arbitrary
feature expression such as (:and :sbcl (:or :x86 :x86-64)), feature expression such as (:and :sbcl (:or :x86 :x86-64)),
which when defined is a precondition to the component being enabled; which when defined is a precondition to the component being enabled;
...@@ -82,6 +76,27 @@ cl-asdf (2:2.27-1) unstable; urgency=low ...@@ -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 massively updated ASDF and its new features with #+asdf2.27.
This is *not* ASDF3, for we painfully maintained backwards compatibility. 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 * Portability updates were done for
ABCL, CLISP, CMUCL, ECL, LispWorks Personal Edition, MKCL, XCL. ABCL, CLISP, CMUCL, ECL, LispWorks Personal Edition, MKCL, XCL.
Working support for GCL 2.6 was restored, with notable limitations Working support for GCL 2.6 was restored, with notable limitations
...@@ -111,7 +126,7 @@ cl-asdf (2:2.27-1) unstable; urgency=low ...@@ -111,7 +126,7 @@ cl-asdf (2:2.27-1) unstable; urgency=low
(defparameter *upgrade-asdf-p* t) (defparameter *upgrade-asdf-p* t)
(pushnew 'try-compile-file-with-asdf *compile-file-for-emacs-hook*) (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 cl-asdf (2:2.26-1) unstable; urgency=low
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- 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: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -19,13 +19,13 @@ ...@@ -19,13 +19,13 @@
(in-package :asdf/package) (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) (defmacro DBG (tag &rest exprs)
"simple debug statement macro: "simple debug statement macro:
outputs a tag plus a list of variable and their values, returns the last value" 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" ;;"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 (gensym))(f (gensym)))
`(let (,res (*print-readably* nil)) `(let (,res (*print-readably* nil))
(flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args))) (flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args)))
...@@ -171,7 +171,7 @@ when the symbol is not found." ...@@ -171,7 +171,7 @@ when the symbol is not found."
(defun ensure-package-fmakunbound-setf (package symbols) (defun ensure-package-fmakunbound-setf (package symbols)
(loop :for name :in symbols (loop :for name :in symbols
:for sym = (find-symbol* name package nil) :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) (defun packages-from-names (names)
(remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t)) (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t))
(defun ensure-package (name &key (defun ensure-package (name &key
...@@ -240,6 +240,7 @@ when the symbol is not found." ...@@ -240,6 +240,7 @@ when the symbol is not found."
(ipn (gethash name inherited))) (ipn (gethash name inherited)))
(multiple-value-bind (x xp) (find-symbol name package) (multiple-value-bind (x xp) (find-symbol name package)
(cond (cond
((gethash name shadowed))
(ipn (ipn
(unless (eq spn ipn) (unless (eq spn ipn)
(error "Can't inherit ~S from ~S, it is inherited from ~S" (error "Can't inherit ~S from ~S, it is inherited from ~S"
...@@ -248,8 +249,6 @@ when the symbol is not found." ...@@ -248,8 +249,6 @@ when the symbol is not found."
(unless (eq symbol x) (unless (eq symbol x)
(error "Can't inherit ~S from ~S, it is imported from ~S" (error "Can't inherit ~S from ~S, it is imported from ~S"
name sp (package-name (symbol-package x))))) name sp (package-name (symbol-package x)))))
((gethash name shadowed)
(error "Can't inherit ~S from ~S, it is shadowed" name spn))
(t (t
(setf (gethash name inherited) spn) (setf (gethash name inherited) spn)
(when xp (when xp
...@@ -294,12 +293,12 @@ when the symbol is not found." ...@@ -294,12 +293,12 @@ when the symbol is not found."
(when (eq ustat :external) (when (eq ustat :external)
(ensure-exported name sym u)))))))) (ensure-exported name sym u))))))))
(assert (soft-upgrade-p upgrade)) (assert (soft-upgrade-p upgrade))
(setf (documentation package t) documentation) #-gcl (setf (documentation package t) documentation) #+gcl documentation
(loop :for p :in discarded (loop :for p :in discarded
:for n = (remove-if #'(lambda (x) (member x names :test 'equal)) :for n = (remove-if #'(lambda (x) (member x names :test 'equal))
(package-names p)) (package-names p))
:do (if n (rename-package discarded (first n) (rest n)) :do (if n (rename-package p (first n) (rest n))
(delete-package* discarded))) (delete-package* p)))
(rename-package package name nicknames) (rename-package package name nicknames)
(loop :for p :in (set-difference (package-use-list package) (append mix use)) (loop :for p :in (set-difference (package-use-list package) (append mix use))
:do (unuse-package p package)) :do (unuse-package p package))
...@@ -389,3 +388,4 @@ when the symbol is not found." ...@@ -389,3 +388,4 @@ when the symbol is not found."
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
#+(or ecl gcl) (defpackage ,package (:use)) #+(or ecl gcl) (defpackage ,package (:use))
(apply 'ensure-package ',(parse-define-package-form package clauses)))) (apply 'ensure-package ',(parse-define-package-form package clauses))))
...@@ -4,8 +4,8 @@ ...@@ -4,8 +4,8 @@
(asdf/package:define-package :asdf/pathname (asdf/package:define-package :asdf/pathname
(:recycle :asdf/pathname :asdf) (:recycle :asdf/pathname :asdf)
(:fmakunbound #:translate-pathname*) (:fmakunbound #:translate-pathname*)
(:use :common-lisp :asdf/utility)
#+gcl<2.7 (:shadowing-import-from :system :*load-pathname*) ;; GCL 2.6 sucks #+gcl<2.7 (:shadowing-import-from :system :*load-pathname*) ;; GCL 2.6 sucks
(:use :common-lisp :asdf/utility)
(:export (:export
#:*resolve-symlinks* #:*resolve-symlinks*
;; Making and merging pathnames, portably ;; Making and merging pathnames, portably
...@@ -60,7 +60,6 @@ ...@@ -60,7 +60,6 @@
Defaults to T.") Defaults to T.")
;;; The hell of portably making and merging pathnames! ;;; The hell of portably making and merging pathnames!
(defun* normalize-pathname-directory-component (directory) (defun* normalize-pathname-directory-component (directory)
......
...@@ -76,9 +76,21 @@ ...@@ -76,9 +76,21 @@
(eval `(trace ,@(loop :for s :in *debug-symbols* :collect (find-symbol (string s) :asdf)))) (eval `(trace ,@(loop :for s :in *debug-symbols* :collect (find-symbol (string s) :asdf))))
(funcall (find-symbol (string :initialize-source-registry) :asdf) (funcall (find-symbol (string :initialize-source-registry) :asdf)
`(:source-registry :ignore-inherited-configuration)) `(: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))) (let ((registry (find-symbol (string :*central-registry*) :asdf)))
(set registry `(,*asdf-directory* ,*test-directory*)))) (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 () (defun load-asdf ()
(load *asdf-fasl*) (load *asdf-fasl*)
(use-package :asdf :asdf-test) (use-package :asdf :asdf-test)
......
...@@ -7,21 +7,26 @@ ...@@ -7,21 +7,26 @@
(asdf:load-system 'test-module-depend) (asdf:load-system 'test-module-depend)
;; test that it compiled ;; 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 ;; and loaded
(assert (eval (intern (symbol-name '#:*file1*) :test-package))) (assert (eval (intern (symbol-name '#:*file1*) :test-package)))
;; now touch file1 and check that file2 _is_ also recompiled ;; now touch file1 and its fasl so the fasl is out of date,
;; this will only work if the cross-module (intra-system) ;; and check that file2 _is_ also recompiled
;; dependency bug is fixed. ;; this didn't work before the cross-module (intra-system) dependency bug was fixed.
(let ((before (file-write-date (asdf:compile-file-pathname* "file2")))) (touch-file "file1.lisp" :timestamp (- file3-date 60))
(sleep 1) (touch-file file1.fasl :timestamp (- file3-date 90))
(asdf::run-shell-command "touch file1.lisp") (touch-file file2.fasl :timestamp (- file3-date 30))
(asdf:operate 'asdf:load-op 'test-module-depend) (touch-file file3.fasl :timestamp (- file3-date 15))
(assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before)) (asdf:operate 'asdf:load-op 'test-module-depend)
;; does this properly go to the second level? (assert (>= (file-write-date (asdf:compile-file-pathname* "file2")) file3-date))
(assert (> (file-write-date (asdf:compile-file-pathname* "file3")) before))))) ;; does this properly go to the second level?
(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 @@ ...@@ -15,13 +15,39 @@
;;;--------------------------------------------------------------------------- ;;;---------------------------------------------------------------------------
(quit-on-error (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) (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
;; test that it compiled ;; test that it compiled
(let ((file1-date (file-write-date (asdf:compile-file-pathname* "file1"))) (let* ((file1 (asdf:compile-file-pathname* "file1"))
(file2-date (file-write-date (asdf:compile-file-pathname* "file2"))) (file2 (asdf:compile-file-pathname* "file2"))
(file3-date (file-write-date (asdf:compile-file-pathname* "file3")))) (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) (unless (and file1-date file2-date file3-date)
(error "Failed to compile one of the three files ~ (error "Failed to compile one of the three files ~
that should be compiled for this test: ~{~a~}" that should be compiled for this test: ~{~a~}"
...@@ -40,9 +66,12 @@ ...@@ -40,9 +66,12 @@
;; this will only work if the cross-module (intra-system) ;; this will only work if the cross-module (intra-system)
;; dependency bug is fixed and the excessive compilation bug is fixed. ;; dependency bug is fixed and the excessive compilation bug is fixed.
(let ((before file2-date)) (let ((before file3-date))
(sleep 1) (touch-file "file1.lisp" :timestamp (- before 60))
(asdf::run-shell-command "touch file1.lisp") (touch-file file1 :timestamp (- before 90))
(touch-file "file2.lisp" :timestamp (- before 30))
(touch-file file2 :timestamp (- before 15))
(let ((plan (asdf::traverse (let ((plan (asdf::traverse
(make-instance 'asdf:load-op) (make-instance 'asdf:load-op)
(asdf:find-system 'test-module-excessive-depend))) (asdf:find-system 'test-module-excessive-depend)))
...@@ -51,9 +80,8 @@ ...@@ -51,9 +80,8 @@
(when (loop :for (o . c) :in plan :thereis (and (eq c file3) (typep o 'asdf:compile-op))) (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."))) (error "Excessive operations on file3-only system. Bad propagation of dependencies.")))
(asdf:operate 'asdf:load-op 'test-module-excessive-depend) (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
(assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before)) (assert (>= (file-write-date file1) before))
(assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before)) (assert (>= (file-write-date file2) before)))
) (unless (= (file-write-date file3)
(unless (= (file-write-date (asdf:compile-file-pathname* "file3"))
file3-date) file3-date)
(error "Excessive compilation of file3.lisp: traverse bug.")))) (error "Excessive compilation of file3.lisp: traverse bug."))))
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
(assert date1) (assert date1)
(assert file) (assert file)
(sleep 1) (sleep 1)
(asdf:run-shell-command "touch ~a" file) (touch-file file)
(asdf:find-system :test1) (asdf:find-system :test1)
(let ((date2 (system-load-time :test1))) (let ((date2 (system-load-time :test1)))
(print (list date1 date2)) (print (list date1 date2))
......
;;; -*- Lisp -*- ;;; -*- Lisp -*-
;;; test system def reloading if touched ;;; test system definition reloading if touched
;;; system that canNOT be found using *system-definition-search-functions* ;;; system that canNOT be found using *system-definition-search-functions*
(load "script-support.lisp") (load "script-support.lisp")
...@@ -11,16 +11,15 @@ ...@@ -11,16 +11,15 @@
(when data (when data
(car data))))) (car data)))))
(setf asdf:*central-registry* nil) (setf asdf:*central-registry* nil)
(load (merge-pathnames "test1.asd")) (load "test1.asd")
(assert (asdf:find-system :test1)) (assert (find-system :test1))
(let ((date1 (system-load-time :test1)) (let ((date1 (system-load-time :test1))
(file (namestring (merge-pathnames "test1.asd")))) (file "test1.asd"))
(assert date1) (assert date1)
(assert file) (assert file)
(sleep 1) (sleep 2)
(asdf:run-shell-command "touch ~a" file) (touch-file file)
(asdf:find-system :test1) (asdf:find-system :test1)
(let ((date2 (system-load-time :test1))) (let ((date2 (system-load-time :test1)))
(assert date2) (assert date2)
(assert (> date2 date1)))))) (assert (> date2 date1))))))
...@@ -3,8 +3,9 @@ ...@@ -3,8 +3,9 @@
(load-asdf) (load-asdf)
(quit-on-error (quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(DBG "loading test1") (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) (asdf:load-system 'test1)
(let* ((file1 (asdf:compile-file-pathname* "file1")) (let* ((file1 (asdf:compile-file-pathname* "file1"))
(file2 (asdf:compile-file-pathname* "file2")) (file2 (asdf:compile-file-pathname* "file2"))
...@@ -18,20 +19,24 @@ ...@@ -18,20 +19,24 @@
(DBG "and loaded") (DBG "and loaded")
(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package))) (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) (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) (asdf:load-system 'test1)
(assert (= file1-date (file-write-date file1))) (DBG "check that file1 is _not_ recompiled, but file2 is" (file-write-date file1))
(assert (< file2-date (file-write-date file2))) (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") (DBG "now touch file1 and check that file2 _is_ also recompiled")
;; XXX run-shell-command loses if *default-pathname-defaults* is not the ;; 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 ;; unix cwd. this is not a problem for run-tests.sh, but can be in general
(let ((before (file-write-date file2))) (let ((before (file-write-date file2)))
;; filesystem mtime has 1 second granularity. Make sure even fast machines see a difference. (touch-file "file1.lisp" :offset -60) ;; touch file1 a minute ago.
(sleep 1) (touch-file file2 :timestamp (- before 10)) ;; touch file2.fasl ten seconds before.
(asdf::run-shell-command "touch file1.lisp") (asdf:clear-system 'test1) (asdf:clear-system 'test1)
(asdf:operate 'asdf:load-op '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 @@ ...@@ -2,5 +2,8 @@
(load "script-support.lisp") (load "script-support.lisp")
(load-asdf) (load-asdf)
(quit-on-error (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)) (load-system :wild-module))
...@@ -31,7 +31,7 @@ ...@@ -31,7 +31,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "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.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 ;; "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-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-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