Commit 9ece06df authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.016.1: Fixes for ABCL, GCL; tweaks for LispWorks and CCL.

Use probe-file for probe-file* in LispWorks.

Make ABCL's jar translation happier with
the recent compile-file-pathname* change for Stelian by redoing cfp myself.

Make truenamize work when the merged pathname is relative.
Makes it happier when e.g. the *default-pathname-defaults* is #p"",
which is the case notably on CCL.

Try and fail to support GCL 2.6 and have 2.7 fail less;
too many bugs, in CONDITIONs, PATHNAMEs, and more,
plus compiler bug that breaks coerce-pathname.
parent 815e0d91
......@@ -4,9 +4,9 @@ webhome_public := "http://common-lisp.net/project/asdf/"
clnet_home := "/project/asdf/public_html/"
sourceDirectory := $(shell pwd)
lisps ?= ccl clisp sbcl ecl abcl xcl scl allegro
## occasionally tested by not me: allegromodern cmucl lispworks
## FAIL: gclcvs (condition handling)
lisps ?= ccl clisp sbcl ecl cmucl abcl xcl scl allegro
## occasionally tested by not me: allegromodern lispworks
## FAIL: gclcvs (COMPILER BUGS!!!)
## tentatively supported by asdf, not supported by our tests: cormancl mcl genera
lisp ?= sbcl
......@@ -64,7 +64,7 @@ mrproper: clean
test-upgrade:
if [ -f /usr/lib/sbcl/sbcl-dist.core ] ; then \
SBCL="/usr/bin/sbcl --core /usr/lib/sbcl/sbcl-dist.core" ; fi ; \
mkdir -p tmp/ ; \
mkdir -p tmp/fasls/sbcl/ ; \
fa=tmp/fasls/sbcl/upasdf.fasl ; \
ll="(handler-bind ((sb-kernel:redefinition-warning #'muffle-warning)) (load \"asdf.lisp\"))" ; \
cf="(handler-bind ((warning #'muffle-warning)) (compile-file \"asdf.lisp\" :output-file \"$$fa\" :verbose nil :print nil))" ; \
......
......@@ -12,7 +12,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.016" ;; to be automatically updated by bin/bump-revision
:version "2.016.1" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components
((:file "asdf")
......
;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.016: Another System Definition Facility.
;;; This is ASDF 2.016.1: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......@@ -62,6 +62,11 @@
(remove "asdf" excl::*autoload-package-name-alist*
:test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below
#+(and ecl (not ecl-bytecmp)) (require :cmp)
#+gcl
(when (or (< system::*gcl-major-version* 2)
(and (= system::*gcl-major-version* 2)
(< system::*gcl-minor-version* 7)))
(pushnew :gcl-pre2.7 *features*))
#+(and (or win32 windows mswindows mingw32) (not cygwin)) (pushnew :asdf-windows *features*)
#+(or unix cygwin) (pushnew :asdf-unix *features*)
;;; make package if it doesn't exist yet.
......@@ -84,14 +89,15 @@
;; Strip out formatting that is not supported on Genera.
;; Has to be inside the eval-when to make Lispworks happy (!)
(defmacro compatfmt (format)
#-genera format
#+genera
#-(or gcl genera) format
#+(or gcl genera)
(loop :for (unsupported . replacement) :in
'(("~@<" . "")
("; ~@;" . "; ")
("~3i~_" . "")
("~@:>" . "")
("~:>" . "")) :do
`(("~3i~_" . "")
#+genera
,@(("~@<" . "")
("; ~@;" . "; ")
("~@:>" . "")
("~:>" . ""))) :do
(loop :for found = (search unsupported format) :while found :do
(setf format
(concatenate 'simple-string
......@@ -106,7 +112,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.016")
(asdf-version "2.016.1")
(existing-asdf (find-class 'component nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
......@@ -367,12 +373,6 @@
;;;; -------------------------------------------------------------------------
;;;; User-visible parameters
;;;;
(defun asdf-version ()
"Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.:
(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.345.67\")."
*asdf-version*)
(defvar *resolve-symlinks* t
"Determine whether or not ASDF resolves symlinks when defining systems.
......@@ -415,7 +415,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
condition-arguments condition-form
condition-format condition-location
coerce-name)
#-cormanlisp
#-(or cormanlisp gcl-pre2.7)
(ftype (function (t t) t) (setf module-components-by-name)))
;;;; -------------------------------------------------------------------------
......@@ -423,19 +423,10 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
#+cormanlisp
(progn
(deftype logical-pathname () nil)
(defun make-broadcast-stream () *error-output*)
(defun file-namestring (p)
(defun* make-broadcast-stream () *error-output*)
(defun* file-namestring (p)
(setf p (pathname p))
(format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p)))
(defparameter *count* 3)
(defun dbg (&rest x)
(format *error-output* "~S~%" x)))
#+cormanlisp
(defun maybe-break ()
(decf *count*)
(unless (plusp *count*)
(setf *count* 3)
(break)))
(format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p))))
;;;; -------------------------------------------------------------------------
;;;; General Purpose Utilities
......@@ -444,7 +435,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
((defdef (def* def)
`(defmacro ,def* (name formals &rest rest)
`(progn
#+(or ecl gcl) (fmakunbound ',name)
#+(or ecl (and gcl (not gcl-pre2.7))) (fmakunbound ',name)
#-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
,(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
`(declaim (notinline ,name)))
......@@ -515,8 +506,11 @@ and NIL NAME, TYPE and VERSION components"
:finally (return (cons defabs (append (reverse defrev) reldir)))))))))))
(defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*))
"MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname
does not have an absolute directory, then the HOST and DEVICE come from the DEFAULTS.
"MERGE-PATHNAMES* is like MERGE-PATHNAMES except that
if the SPECIFIED pathname does not have an absolute directory,
then the HOST and DEVICE both come from the DEFAULTS, whereas
if the SPECIFIED pathname does have an absolute directory,
then the HOST and DEVICE both come from the SPECIFIED.
Also, if either argument is NIL, then the other argument is returned unmodified."
(when (null specified) (return-from merge-pathnames* defaults))
(when (null defaults) (return-from merge-pathnames* specified))
......@@ -730,7 +724,7 @@ actually-existing directory."
#+genera
(unless (fboundp 'ensure-directories-exist)
(defun ensure-directories-exist (path)
(defun* ensure-directories-exist (path)
(fs:create-directories-recursively (pathname path))))
(defun* absolute-pathname-p (pathspec)
......@@ -798,22 +792,25 @@ with given pathname and if it exists return its truename."
(null nil)
(string (probe-file* (parse-namestring p)))
(pathname (unless (wild-pathname-p p)
#.(or #+(or allegro clozure cmu cormanlisp ecl sbcl scl) '(probe-file p)
#.(or #+(or allegro clozure cmu cormanlisp ecl lispworks sbcl scl)
'(probe-file p)
#+clisp (aif (find-symbol* '#:probe-pathname :ext)
`(ignore-errors (,it p)))
'(ignore-errors (truename p)))))))
(defun* truenamize (p)
(defun* truenamize (pathname &optional (defaults *default-pathname-defaults*))
"Resolve as much of a pathname as possible"
(block nil
(when (typep p '(or null logical-pathname)) (return p))
(let* ((p (merge-pathnames* p))
(directory (pathname-directory p)))
(when (typep pathname '(or null logical-pathname)) (return pathname))
(let ((p (merge-pathnames* pathname defaults)))
(when (typep p 'logical-pathname) (return p))
(let ((found (probe-file* p)))
(when found (return found)))
#-(or cmu sbcl scl) (when (stringp directory) (return p))
(when (not (eq :absolute (car directory))) (return p))
(unless (absolute-pathname-p p)
(let ((true-defaults (ignore-errors (truename defaults))))
(when true-defaults
(setf p (merge-pathnames pathname true-defaults)))))
(unless (absolute-pathname-p p) (return p))
(let ((sofar (probe-file* (pathname-root p))))
(unless sofar (return p))
(flet ((solution (directories)
......@@ -824,7 +821,9 @@ with given pathname and if it exists return its truename."
:type (pathname-type p)
:version (pathname-version p))
sofar)))
(loop :for component :in (cdr directory)
(loop :with directory = (normalize-pathname-directory-component
(pathname-directory p))
:for component :in (cdr directory)
:for rest :on (cdr directory)
:for more = (probe-file*
(merge-pathnames*
......@@ -847,7 +846,7 @@ with given pathname and if it exists return its truename."
(and path (resolve-symlinks path))
path))
(defun ensure-pathname-absolute (path)
(defun* ensure-pathname-absolute (path)
(cond
((absolute-pathname-p path) path)
((stringp path) (ensure-pathname-absolute (pathname path)))
......@@ -877,7 +876,7 @@ with given pathname and if it exists return its truename."
(merge-pathnames* *wild-path* path))
#-scl
(defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
(defun* directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
(let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname)))
(last-char (namestring foo))))
......@@ -961,7 +960,7 @@ another pathname in a degenerate way."))
(defgeneric* (setf component-property) (new-value component property))
(eval-when (:compile-toplevel :load-toplevel :execute)
(eval-when (#-gcl :compile-toplevel :load-toplevel :execute)
(defgeneric* (setf module-components-by-name) (new-value module)))
(defgeneric* version-satisfies (component version))
......@@ -1270,8 +1269,8 @@ processed in order by OPERATE."))
(slot-value component 'absolute-pathname)
(let ((pathname
(merge-pathnames*
(component-relative-pathname component)
(pathname-directory-pathname (component-parent-pathname component)))))
(component-relative-pathname component)
(pathname-directory-pathname (component-parent-pathname component)))))
(unless (or (null pathname) (absolute-pathname-p pathname))
(error (compatfmt "~@<Invalid relative pathname ~S for component ~S~@:>")
pathname (component-find-path component)))
......@@ -1312,7 +1311,13 @@ processed in order by OPERATE."))
(return-from version-satisfies t))
(version-satisfies (component-version c) version))
(defun parse-version (string &optional on-error)
(defun* asdf-version ()
"Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.:
(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.345.67\")."
*asdf-version*)
(defun* parse-version (string &optional on-error)
"Parse a version string as a series of natural integers separated by dots.
Return a (non-null) list of integers if the string is valid, NIL otherwise.
If on-error is error, warn, or designates a function of compatible signature,
......@@ -1531,7 +1536,7 @@ Going forward, we recommend new users should be using the source-registry.
(let ((*systems-being-defined* (make-hash-table :test 'equal)))
(funcall thunk))))
(defmacro with-system-definitions (() &body body)
(defmacro with-system-definitions ((&optional) &body body)
`(call-with-system-definitions #'(lambda () ,@body)))
(defun* load-sysdef (name pathname)
......@@ -2113,7 +2118,7 @@ recursive calls to traverse.")
(flags :initarg :flags :accessor compile-op-flags
:initform nil)))
(defun output-file (operation component)
(defun* output-file (operation component)
"The unique output file of performing OPERATION on COMPONENT"
(let ((files (output-files operation component)))
(assert (length=n-p files 1))
......@@ -2144,8 +2149,8 @@ recursive calls to traverse.")
(*compile-file-warnings-behaviour* (operation-on-warnings operation))
(*compile-file-failure-behaviour* (operation-on-failure operation)))
(multiple-value-bind (output warnings-p failure-p)
(apply *compile-op-compile-file-function* source-file :output-file output-file
(compile-op-flags operation))
(apply *compile-op-compile-file-function* source-file
:output-file output-file (compile-op-flags operation))
(unless output
(error 'compile-error :component c :operation operation))
(when failure-p
......@@ -3523,11 +3528,13 @@ effectively disabling the output translation facility."
(defun* compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys)
(if (absolute-pathname-p output-file)
(apply 'compile-file-pathname (lispize-pathname input-file) keys)
;; what cfp should be doing, w/ mp* instead of mp
(let* ((type (pathname-type (apply 'compile-file-pathname "x.lisp" keys)))
(defaults (make-pathname
:type type :defaults (merge-pathnames* input-file))))
(merge-pathnames* output-file defaults))
(apply-output-translations
(apply 'compile-file-pathname
(truenamize (lispize-pathname input-file))
keys))))
(apply 'compile-file-pathname input-file keys))))
(defun* tmpize-pathname (x)
(make-pathname
......@@ -3728,11 +3735,11 @@ with a different configuration, so the configuration would be re-read then."
(defparameter *wild-asd*
(make-pathname :directory nil :name *wild* :type "asd" :version :newest))
(defun directory-asd-files (directory)
(defun* directory-asd-files (directory)
(ignore-errors
(directory* (merge-pathnames* *wild-asd* directory))))
(defun subdirectories (directory)
(defun* subdirectories (directory)
(let* ((directory (ensure-directory-pathname directory))
#-(or abcl cormanlisp genera xcl)
(wild (merge-pathnames*
......@@ -3760,17 +3767,17 @@ with a different configuration, so the configuration would be re-read then."
#+(or cmu lispworks scl) x)))
dirs))
(defun collect-asds-in-directory (directory collect)
(defun* collect-asds-in-directory (directory collect)
(map () collect (directory-asd-files directory)))
(defun collect-sub*directories (directory collectp recursep collector)
(defun* collect-sub*directories (directory collectp recursep collector)
(when (funcall collectp directory)
(funcall collector directory))
(dolist (subdir (subdirectories directory))
(when (funcall recursep subdir)
(collect-sub*directories subdir collectp recursep collector))))
(defun collect-sub*directories-asd-files
(defun* collect-sub*directories-asd-files
(directory &key
(exclude *default-source-registry-exclusions*)
collect)
......
......@@ -17,6 +17,8 @@
<div class="system-links">
<ul>
<li><a href="#what_it_is">What it is</a></li>
<li><a href="#what_it_is_not">What it is not</a></li>
<li><a href="#implementations">Supported Implementations</a></li>
<li><a href="#documentation">Documentation</a></li>
<li><a href="#downloads">Getting it</a></li>
<li><a href="#bugs">Reporting Bugs</a></li>
......@@ -30,16 +32,6 @@
<h3>ASDF 2</h3>
<p>We released ASDF 2 on May 31st 2010.
It has since been widely adopted by the CL community.
</p><p>
These implementations provide ASDF 2 in their latest release
so you can just <tt>(require "asdf")</tt>:
(free) abcl ccl clisp cmucl ecl sbcl xcl; (proprietary) allegro.
</p><p>
These implementations work with ASDF 2 but don't bundle ASDF 2 yet:
(proprietary) lispworks scl.
</p><p>
These implementations are obsolete, yet are somewhat supported by ASDF 2:
(free) gcl mcl; (proprietary) cormanlisp genera.
</p>
<a id="what_it_is"></a>
<h3>What it is</h3>
......@@ -56,14 +48,73 @@
<h3>What it is not</h3>
<p>ASDF will not download missing software components for you.
For that, you want <a href="http://quicklisp.org/">Quicklisp</a>,
that builds upon ASDF, and is great for pulling
a tarballs of packages you may depend upon,
or <a href="http://common-lisp.net/project/clbuild/">clbuild</a>,
that now builds upon Quicklisp, and is great for pulling
packages you need to modify from version control.
that builds upon ASDF, and is great for pulling and installing
tarballs of packages you may depend upon;
we also recommend <a href="http://common-lisp.net/project/clbuild/">clbuild</a>,
that now builds upon Quicklisp, as a great tool for pulling from version control
packages you need to modify or want to contribute to.
We recommend you should not use ASDF-Install anymore,
another such piece of software that is both unmaintained and obsolete.
as it is another such piece of software that is both unmaintained and obsolete.
</p>
<a id="implmementations"></a>
<h3>Supported Implementations</h3>
<p>ASDF 2 now supports all CL implementations
that seem to have any current user base.
</p><p>
Most implementations provide ASDF 2 as a module,
and you can simply <tt>(require :asdf)</tt> or <tt>(require "asdf")</tt>.
Note that most implementations accept
<tt>:asdf</tt>, <tt>"ASDF"</tt> and <tt>"asdf"</tt>
indiscriminately, but that as exceptions,
CMUCL accepts only upper-case (or a case-converted symbol),
whereas CLISP accepts only lower-case
(in a string, or again a case-converted symbol again).
</p><p>
A few implementations don't provide ASDF yet,
but have announced they will in their next release.
As for remaining implementations,
they are obsolete or mostly unmaintained,
ASDF 2 supports them if you load it manually,
though there might never be a next release
to provide it through <tt>require</tt>.
</p>
<table>
<tr><th></th>
<th align="left">Provide "asdf"</th>
<th align="left">Will provide it</th>
<th align="left">Obsolete</th></tr>
<tr><th align="left">Free</th>
<td align="left">abcl ccl clisp cmucl ecl sbcl xcl</td>
<td> </td>
<td align="left">gcl mcl</td></tr>
<tr><th align="left">Proprietary</th>
<td align="left">allegro</td>
<td align="left">lispworks scl</td>
<td align="left">cormanlisp genera</td></tr>
</table>
<!-- Note to self:
The maintainers of the following implementations follow asdf-announce:
allegro Gary King <gwking@franz.com>
clisp (sds)
ecl (juanjo)
The maintainers of the following implementations require direct notification:
abcl ccl cmucl gcl lispworks sbcl scl xcl
Armed Bear <armedbear-devel@common-lisp.net>,
openmcl-devel@clozure.com,
cmucl-imp@cons.org,
gcl-devel@gnu.org,
lisp-support@lispworks.com,
SBCL Devel-list <sbcl-devel@lists.sourceforge.net>,
Douglas Crosher <dtc3@scieneer.com>,
Peter Graves <gnooth@gmail.com>
-->
<p>
If there is an old or new implementation that we are missing,
it shouldn't hard to adapt ASDF to support it.
Ask us!
</p>
<a id="documentation"></a>
<h3>Documentation</h3>
<p>You can read our manual:</p>
......@@ -73,11 +124,16 @@
<li><a href="asdf.pdf">as a PDF document</a></li>
<li><a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git;a=blob;f=doc/asdf.texinfo">as texinfo source</a></li>
</ul>
<p>Regarding the internal design of ASDF and the work we did on ASDF 2,
<p>Regarding the internal design of ASDF in general and the work we did on ASDF 2,
see the last draft version of our paper for
<a href="http://www.international-lisp-conference.org/2010/index">ILC 2010</a>,
<cite><a href="ilc2010draft.pdf"
>Evolving ASDF: More Cooperation, Less Coordination</a></cite></p>
<p>Finally, while the manual covers all the basics,
some advanced or new features remain underdocumented.
Please contact our mailing-list (see below)
for any issue that isn't well-documented enough.
</p>
<a id="downloads"></a>
<h3>Getting it</h3>
......@@ -111,7 +167,7 @@
<a id="bugs">
<h3>Reporting Bugs</h3>
<p>To report bugs, you can use our
<p>To report bugs, you can use our
<a href="https://launchpad.net/asdf/">launchpad project</a>.
If you're unsure about the bug or want to discuss how to fix it,
you can send email to the project mailing-list below.
......@@ -176,9 +232,9 @@
<a class="nav" href="http://www.catb.org/hacker-emblem/" title="hacker"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/hacker.png" width="80" height="15" title="hacker emblem" alt="hacker button" /></a>
<a class="nav" href="http://www.lisp.org/" title="Association of Lisp Users"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/lambda-lisp.png" width="80" height="15" title="ALU emblem" alt="ALU button" /></a>
<a class="nav" href="http://common-lisp.net/" title="Common-Lisp.net"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/lisp-lizard.png" width="80" height="15" title="Common-Lisp.net" alt="Common-Lisp.net button" /></a>
<p><span class="copyright"Copyright &copy; 2001-2010 Daniel Barlow and contributors</span></p>
<p><span class="copyright"Copyright &copy; 2001-2011 Daniel Barlow and contributors</span></p>
<p>ASDF has an <a href="http://www.opensource.org/licenses/mit-license.php">MIT style</a> license</p>
<div id="timestamp">Last updated 2011-05-08</div>
<div id="timestamp">Last updated 2011-06-08</div>
</div>
</body>
</html>
......@@ -2,6 +2,8 @@
(load "script-support.lisp")
(load-asdf)
#+gcl (trace asdf:compile-file-pathname*)
;;; test asdf pathname specifications
;;;
;;; this is intended to run in a directory like '/test/20100310T000000Z/sbcl', in which it creates a
......@@ -34,6 +36,7 @@
(delete-host t)
(support-string-pathnames nil)
(support-absolute-string-pathnames nil))
#+gcl (format t "root: ~S~%" root)
(unwind-protect
(let* ((bin-type (pathname-type (compile-file-pathname "test.lisp")))
(root-directory-namestring (format nil "~{/~a~}/" (rest (pathname-directory root))))
......@@ -49,8 +52,10 @@
(with-open-file (result-stream (asdf::merge-pathnames* "output.txt" root)
:direction :output
:if-exists :supersede :if-does-not-exist :create)
(flet ((src-dir (&rest path) (append (pathname-directory root) (cons "asdf-src" path)))
(bin-dir (&rest path) (append (pathname-directory root) (cons "asdf-bin" path))))
(flet ((src-dir (&rest path) (append (or (pathname-directory root) (list :relative))
(cons "asdf-src" path)))
(bin-dir (&rest path) (append (or (pathname-directory root) (list :relative))
(cons "asdf-bin" path))))
(setf (logical-pathname-translations "ASDFTEST")
`((,(format nil "**;*.~a" bin-type)
,(make-pathname :directory (bin-dir :wild-inferiors)
......@@ -290,6 +295,7 @@
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz") :directory t) #p"/foo/bar/baz/"))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz") :directory t :wilden t) (asdf::wilden #p"/foo/bar/baz/")))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz") :directory nil :wilden t) (asdf::wilden #p"/foo/bar/")))
#-gcl
(assert (equal (asdf::resolve-location '("/foo" "bar" #p"**/" "baz" #p"*.*") :directory nil :wilden t) #p"/foo/bar/**/baz/*.*")))
(or (test-component-pathnames :delete-host t :support-string-pathnames nil)
......
(in-package #:common-lisp-user)
(declaim (optimize (speed 2) (safety 3) #-allegro (debug 3)))
(proclaim '(optimize (speed 2) (safety 3) #-allegro (debug 3)))
(load (make-pathname :name "script-support" :defaults *load-pathname*))
......
;;; -*- Lisp -*-
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
;;(trace asdf:operation-done-p asdf::safe-file-write-date)
(asdf:operate 'asdf:load-op 'static-and-serial)
(let* ((file1 (asdf:compile-file-pathname* "file1"))
(in-package :asdf)
(trace #+gcl coerce-pathname)
(cl-user::quit-on-error
(format t "dpd: ~S~%f1: ~S~%" *default-pathname-defaults* (asdf:merge-pathnames* "file1"))
(setf *central-registry* '(*default-pathname-defaults*))
(operate 'load-op 'static-and-serial)
(let* ((file1 (compile-file-pathname* "file1.lisp"))
(file1-date (file-write-date file1))
(asdf::*defined-systems* (make-hash-table :test 'equal))) ;; cheat
(*defined-systems* (make-hash-table :test 'equal))) ;; cheat
(format t "file: ~S~%date: ~S~%" file1 file1-date)
(assert file1-date)
;; date should stay same
(sleep 1)
(asdf:operate 'asdf:load-op 'static-and-serial)
(assert (= (file-write-date file1) file1-date))))
(operate 'load-op 'static-and-serial)
(assert (equal (file-write-date file1) file1-date))))
......@@ -11,6 +11,7 @@
(namestring
(compile-file-pathname "try-recompiling-1")))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
#-gcl
(handler-bind ((error (lambda (c)
(setf *caught-error* t)
(multiple-value-bind (name mode)
......
......@@ -12,6 +12,7 @@
(assert (and (probe-file (asdf:compile-file-pathname* (truename "file3.lisp")))
(probe-file (asdf:compile-file-pathname* (truename "file4.lisp")))))
(format t "test2 3~%")
#-gcl
(handler-case
(asdf:oos 'asdf:load-op 'test2b2)
(asdf:missing-dependency (c)
......@@ -20,6 +21,7 @@
(declare (ignore c))
(error "should have failed, oops")))
(format t "test2 4~%")
#-gcl
(handler-case
(asdf:oos 'asdf:load-op 'test2b3)
(asdf:missing-dependency (c)
......
......@@ -10,6 +10,7 @@
(ns2 (#-scl namestring #+scl ext:unix-namestring fasl2)))
(asdf:run-shell-command "rm -f ~A ~A" ns1 ns2)
(setf asdf:*central-registry* '(*default-pathname-defaults*))
#-gcl
(handler-case
(asdf:oos 'asdf:load-op 'test3)
(asdf:missing-dependency (c)
......
......@@ -8,5 +8,4 @@
(assert (not (component-property (find-system 'test3) :foo)))
(assert (equal (component-property (find-system 'test3) :prop1) "value"))
(setf (component-property (find-system 'test3) :foo) "bar")
(assert (equal (component-property (find-system 'test3) :foo) "bar"))
)
\ No newline at end of file
(assert (equal (component-property (find-system 'test3) :foo) "bar")))
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