## MAJOR FAIL: gclcvs -- Compiler bug fixed upstream, but gcl fails to compile on modern Linuxen.
## grep for #+/#- features in the test/ directory to see plenty of disabled tests.
-lisp ?= sbcl
+l ?= sbcl
ABCL ?= abcl
ALLEGRO ?= alisp
rm -rf .pc/ build-stamp debian/patches/ debian/debhelper.log debian/cl-asdf/ # debian crap
test-upgrade: build/asdf.lisp
- ./test/run-tests.sh -u ${lisp}
+ ./test/run-tests.sh -u ${l}
+u: test-upgrade
test-clean-load: build/asdf.lisp
- ./test/run-tests.sh -c ${lisp}
+ ./test/run-tests.sh -c ${l}
+# test-glob has been replaced by t, and lisp by l, easier to type
test-lisp: build/asdf.lisp
- @cd test; ${MAKE} clean;./run-tests.sh ${lisp} ${test-glob}
+ @cd test; ${MAKE} clean;./run-tests.sh ${l} ${t}
+t: test-lisp
test: test-lisp test-clean-load doc
test-all-lisps:
@for lisp in ${lisps} ; do \
- ${MAKE} test-lisp test-upgrade lisp=$$lisp || exit 1 ; \
+ ${MAKE} test-lisp test-upgrade l=$$lisp || exit 1 ; \
done
# test upgrade is a very long run... This does just the regression tests
test-all-noupgrade:
@for lisp in ${lisps} ; do \
- ${MAKE} test-lisp lisp=$$lisp || exit 1 ; \
+ ${MAKE} test-lisp l=$$lisp || exit 1 ; \
done
test-all-upgrade:
@for lisp in ${lisps} ; do \
- ${MAKE} test-upgrade lisp=$$lisp || exit 1 ; \
+ ${MAKE} test-upgrade l=$$lisp || exit 1 ; \
done
test-all: test-forward-references doc test-all-lisps
#:action-status #:action-stamp #:action-done-p
#:component-operation-time #:mark-operation-done #:compute-action-stamp
#:perform #:perform-with-restarts #:retry #:accept #:feature
- #:traverse-actions #:traverse-sub-actions #:required-components #:required-files ;; in plan
+ #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
))
(in-package :asdf/action)
(defgeneric* traverse-actions (actions &key &allow-other-keys))
(defgeneric* traverse-sub-actions (operation component &key &allow-other-keys))
(defgeneric* required-components (component &key &allow-other-keys))
-(defgeneric* required-files (operation component &key &allow-other-keys))
;;;; Convenience methods
(defmacro define-convenience-action-methods
- (function (operation component &rest more-args) &key if-no-operation if-no-component)
- (let ((rest (gensym "REST"))
- (found (gensym "FOUND")))
- `(progn
- (defmethod ,function ((,operation symbol) ,component
- ,@(when more-args `(&rest ,rest))
- ,@(when (member '&key more-args) `(&key &allow-other-keys)))
- (if ,operation
- ,(if more-args
- `(apply ',function (make-operation ,operation) ,component ,rest)
- `(,function (make-operation ,operation) ,component))
- ,if-no-operation))
- (defmethod ,function ((,operation operation) ,component
- ,@(when more-args `(&rest ,rest))
- ,@(when (member '&key more-args) `(&key &allow-other-keys)))
- (if (typep ,component 'component)
- (error "No defined method for ~S on ~S" ',function ,component)
- (let ((,found (find-component () ,component)))
- (if ,found
- ,(if more-args
- `(apply ',function ,operation ,found ,rest)
- `(,function ,operation ,found))
- ,if-no-component)))))))
+ (function (operation component &optional keyp)
+ &key if-no-operation if-no-component operation-initargs)
+ (let* ((rest (gensym "REST"))
+ (found (gensym "FOUND"))
+ (more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
+ (flet ((next-method (o c)
+ (if keyp
+ `(apply ',function ,o ,c ,rest)
+ `(,function ,o ,c))))
+ `(progn
+ (defmethod ,function ((,operation symbol) ,component ,@more-args)
+ (if ,operation
+ ,(next-method
+ (if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck.
+ `(apply 'make-operation ,operation :original-initargs ,rest ,rest)
+ `(make-operation ,operation))
+ `(find-component () ,component))
+ ,if-no-operation))
+ (defmethod ,function ((,operation operation) ,component ,@more-args)
+ (if (typep ,component 'component)
+ (error "No defined method for ~S on ~S" ',function ,component)
+ (let ((,found (find-component () ,component)))
+ (if ,found
+ ,(next-method operation found)
+ ,if-no-component))))))))
;;;; self-description
You can put together sentences using this phrase."))
(defmethod operation-description (operation component)
(format nil (compatfmt "~@<~A on ~A~@:>")
- (class-of operation) component))
-(define-convenience-action-methods operation-description (operation component))
-
+ (type-of operation) component))
(defgeneric* explain (operation component))
(defmethod explain ((o operation) (c component))
(asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (operation-description o c)))
;;;; Inputs, Outputs, and invisible dependencies
-(defgeneric* output-files (operation component))
-(defgeneric* input-files (operation component))
+(defgeneric* (output-files) (operation component))
+(defgeneric* (input-files) (operation component))
(defgeneric* operation-done-p (operation component)
(:documentation "Returns a boolean, which is NIL if the action is forced to be performed again"))
(define-convenience-action-methods output-files (operation component))
(values
(multiple-value-bind (pathnames fixedp) (call-next-method)
;; 1- Make sure we have absolute pathnames
- (let* ((directory (pathname-directory-pathname (component-pathname component)))
+ (let* ((directory (pathname-directory-pathname
+ (component-pathname (find-component () component))))
(absolute-pathnames
(loop
:for pathname :in pathnames
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
- :version "2.26.125" ;; to be automatically updated by bin/bump-revision
+ :version "2.26.126" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
(declare (ignorable o))
(perform (make-instance 'load-source-op) c))
-#+(and clisp (not asdf2.27))
-(rename-package :asdf :asdf-utilities)
-
#+asdf2.27
(defsystem :asdf/defsystem
:licence "MIT"
:asdf/run-program :asdf/lisp-build
:asdf/configuration)
(:export
- #:coerce-pathname #:component-name-to-pathname-components))
+ #:coerce-pathname #:component-name-to-pathname-components
+ #+(or ecl mkcl) #:compile-file-keeping-object
+ ))
(in-package :asdf/backward-driver)
;;;; Backward compatibility with various pathname functions.
unix-style-namestring))
(values relabs path filename)))
+#+(or ecl mkcl)
+(defun* compile-file-keeping-object (&rest args) (apply #'compile-file* args))
(:export
#:bundle-op #:bundle-op-build-args #:bundle-type #:bundle-system #:bundle-pathname-type
#:fasl-op #:load-fasl-op #:lib-op #:dll-op #:binary-op
- #:monolithic-op #:monolithic-bundle-op #:required-files
+ #:monolithic-op #:monolithic-bundle-op #:direct-dependency-files
#:monolithic-binary-op #:monolithic-fasl-op #:monolithic-lib-op #:monolithic-dll-op
#:program-op
#:compiled-file #:precompiled-system #:prebuilt-system
#+mkcl (equal type (compile-file-type :fasl-p nil))
#+(or allegro clisp clozure cmu lispworks sbcl scl xcl) (equal type (compile-file-type)))))
-(defgeneric* trivial-system-p (component))
+(defgeneric* (trivial-system-p) (component))
(defun* user-system-p (s)
(and (typep s 'system)
(declare (ignorable o))
`((lib-op ,@(required-components c :other-systems t :component-type 'system
:goal-operation 'load-op
- :keep-operation 'load-op))))
+ :keep-operation 'compile-op))))
(defmethod component-depends-on ((o monolithic-fasl-op) (c system))
(declare (ignorable o))
`((fasl-op ,@(required-components c :other-systems t :component-type 'system
:goal-operation 'load-fasl-op
- :keep-operation 'load-fasl-op))))
+ :keep-operation 'fasl-op))))
(defmethod component-depends-on ((o program-op) (c system))
(declare (ignorable o))
(declare (ignorable o))
`((compile-op ,@(required-components c :other-systems nil :component-type '(not system)
:goal-operation 'load-op
- :keep-operation 'load-op))))
+ :keep-operation 'compile-op))))
(defmethod component-depends-on ((o fasl-op) (c system))
(declare (ignorable o))
`((,op ,c))
(call-next-method)))
-(defmethod required-files (o c &key (test 'identity) (key 'output-files) &allow-other-keys)
+(defun* direct-dependency-files (o c &key (test 'identity) (key 'output-files) &allow-other-keys)
(while-collecting (collect)
- (visit-dependencies
- () o c #'(lambda (sub-o sub-c)
- (loop :for f :in (funcall key sub-o sub-c)
- :when (funcall test f) :do (collect f))))))
+ (map-direct-dependencies
+ o c #'(lambda (sub-o sub-c)
+ (loop :for f :in (funcall key sub-o sub-c)
+ :when (funcall test f) :do (collect f))))))
(defmethod input-files ((o bundle-op) (c system))
- (required-files o c :test 'bundlable-file-p :key 'output-files))
+ (direct-dependency-files o c :test 'bundlable-file-p :key 'output-files))
(defun* select-bundle-operation (type &optional monolithic)
(ecase type
(non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'string=))
(output-files (output-files o c))
(output-file (first output-files)))
+ (unless input-files (format t "WTF no input-files for ~S on ~S !???" o c))
(when input-files
(assert output-files)
(when non-fasl-files
#:module-default-component-class
#:module-components ;; backward-compatibility. DO NOT USE.
- ;; Internals we'd like to share with the ASDF package.
- #:name #:version #:description #:long-description
+ ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
+ #:name #:version #:description #:long-description #:author #:maintainer #:licence
+ #:defsystem-depends-on
#:sibling-dependencies #:if-feature #:in-order-to #:inline-methods
#:relative-pathname #:absolute-pathname #:operation-times #:around-compile
#:%encoding #:properties #:parent))
:accessor component-operation-times)
(around-compile :initarg :around-compile)
(%encoding :accessor %component-encoding :initform nil :initarg :encoding)
- ;; XXX we should provide some atomic interface for updating the
- ;; component properties
+ ;; ASDF3: get rid of these "component properties" ?
(properties :accessor component-properties :initarg :properties
:initform nil)
;; For backward-compatibility, this slot is part of component rather than child-component
;;;; component pathnames
-(defgeneric* component-parent-pathname (component))
+(defgeneric* (component-parent-pathname) (component))
(defmethod component-parent-pathname (component)
(component-pathname (component-parent component)))
(return inputs)))
(defmethod input-files ((o load-concatenated-source-op) (s system))
- (required-files o s))
+ (direct-dependency-files o s))
(defmethod input-files ((o compile-concatenated-source-op) (s system))
- (required-files o s))
+ (direct-dependency-files o s))
(defmethod output-files ((o compile-concatenated-source-op) (s system))
(let ((input (first (input-files o s))))
(list (compile-file-pathname input))))
(defmethod input-files ((o load-compiled-concatenated-source-op) (s system))
- (required-files o s))
+ (direct-dependency-files o s))
(defmethod perform ((o concatenate-source-op) (s system))
(let ((inputs (input-files o s))
#:report-invalid-form #:invalid-configuration #:*ignored-configuration-form*
#:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook
#:resolve-location #:location-designator-p #:location-function-p #:*here-directory*
- #:resolve-relative-location-component #:resolve-absolute-location-component))
+ #:resolve-relative-location #:resolve-absolute-location))
(in-package :asdf/configuration)
(define-condition invalid-configuration ()
:do (report-invalid-form invalid-form-reporter :form form :location file)))
:inherit-configuration)))
-(defun* resolve-relative-location-component (x &key ensure-directory wilden)
+(defun* resolve-relative-location (x &key ensure-directory wilden)
(ensure-pathname
(etypecase x
(pathname x)
x :ensure-directory ensure-directory))
(cons
(if (null (cdr x))
- (resolve-relative-location-component
+ (resolve-relative-location
(car x) :ensure-directory ensure-directory :wilden wilden)
- (let* ((car (resolve-relative-location-component
+ (let* ((car (resolve-relative-location
(car x) :ensure-directory t :wilden nil)))
(merge-pathnames*
- (resolve-relative-location-component
+ (resolve-relative-location
(cdr x) :ensure-directory ensure-directory :wilden wilden)
car))))
((eql :*/) *wild-directory*)
'(:home ".cache" "common-lisp" :implementation)))))
(register-image-restore-hook 'compute-user-cache)
-(defun* resolve-absolute-location-component (x &key ensure-directory wilden)
+(defun* resolve-absolute-location (x &key ensure-directory wilden)
(ensure-pathname
(etypecase x
(pathname x)
#+mcl (unless p (error "POSIX pathname ~S does not exist" x))
(if ensure-directory (ensure-directory-pathname p) p)))
(cons
- (return-from resolve-absolute-location-component
+ (return-from resolve-absolute-location
(if (null (cdr x))
- (resolve-absolute-location-component
+ (resolve-absolute-location
(car x) :ensure-directory ensure-directory :wilden wilden)
(merge-pathnames*
- (resolve-relative-location-component
+ (resolve-relative-location
(cdr x) :ensure-directory ensure-directory :wilden wilden)
- (resolve-absolute-location-component
+ (resolve-absolute-location
(car x) :ensure-directory t :wilden nil)))))
((eql :root)
;; special magic! we return a relative pathname,
;; but what it means to the output-translations is
;; "relative to the root of the source pathname's host and device".
- (return-from resolve-absolute-location-component
+ (return-from resolve-absolute-location
(let ((p (make-pathname* :directory '(:relative))))
(if wilden (wilden p) p))))
((eql :home) (user-homedir))
- ((eql :here) (resolve-absolute-location-component
+ ((eql :here) (resolve-absolute-location
*here-directory* :ensure-directory t :wilden nil))
- ((eql :user-cache) (resolve-absolute-location-component
+ ((eql :user-cache) (resolve-absolute-location
*user-cache* :ensure-directory t :wilden nil)))
:wilden (and wilden (not (pathnamep x)))
:want-absolute t))
-(defun* resolve-location (x &key ensure-directory wilden directory)
+(defun* (resolve-location) (x &key ensure-directory wilden directory)
(when directory (setf ensure-directory t)) ;; :directory backward compatibility, until 2014-01-16.
(if (atom x)
- (resolve-absolute-location-component x :ensure-directory ensure-directory :wilden wilden)
+ (resolve-absolute-location x :ensure-directory ensure-directory :wilden wilden)
(loop :with (first . rest) = x
- :with path = (resolve-absolute-location-component
+ :with path = (resolve-absolute-location
first :ensure-directory (and (or ensure-directory rest) t)
:wilden (and wilden (null rest)))
:for (element . morep) :on rest
:for dir = (and (or morep ensure-directory) t)
:for wild = (and wilden (not morep))
:do (setf path (merge-pathnames*
- (resolve-relative-location-component
+ (resolve-relative-location
element :ensure-directory dir :wilden wild)
path))
:finally (return path))))
;; If no absolute pathname was found, we return NIL.
(check-type pathname (or null string pathname))
(absolutize-pathnames
- (list pathname (load-pathname) *default-pathname-defaults*
- #-(or abcl gcl genera) (getcwd))
+ (list pathname (load-pathname) *default-pathname-defaults* (getcwd))
:resolve-symlinks *resolve-symlinks*))
(equal (missing-requires c) name))))))))
(defun* resolve-dependency-spec (component dep-spec)
- (if (atom dep-spec)
- (resolve-dependency-name component dep-spec)
- (resolve-dependency-combination component (car dep-spec) (cdr dep-spec))))
+ (let ((component (find-component () component)))
+ (if (atom dep-spec)
+ (resolve-dependency-name component dep-spec)
+ (resolve-dependency-combination component (car dep-spec) (cdr dep-spec)))))
(defmethod resolve-dependency-combination (component combinator arguments)
(error (compatfmt "~@<Bad dependency ~S for ~S~@:>")
(let* ((file (probe-file*
(absolutize-pathnames
(list (make-pathname :name name :type "asd")
- defaults *default-pathname-defaults*
- #-(or abcl gcl genera) (getcwd))
+ defaults *default-pathname-defaults* (getcwd))
:resolve-symlinks truename)
:truename truename)))
(when file
(subseq *central-registry* (1+ position))))))))))
(defun* make-temporary-package ()
- (make-package (fresh-package-name :asdf 0) :use '(:cl :asdf/interface)))
+ (make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf/interface)))
(defmethod find-system ((name null) &optional (error-p t))
(declare (ignorable name))
(defun* sysdef-find-pre-loaded-systems (requested)
(loop :for (provided . keys) :in *pre-loaded-systems*
:thereis (apply 'find-system-fallback requested provided keys)))
+
+;;;; Beware of builtin systems
+(defmethod builtin-system-p ((s system))
+ (or
+ ;; For most purposes, asdf itself specially counts as builtin.
+ ;; if you want to link it or do something forbidden to builtins,
+ ;; specify separate dependencies on asdf-driver and asdf-defsystem.
+ (equal "asdf" (coerce-name s))
+ ;; Other builtin systems are those under the implementation directory
+ (let* ((system (find-system s nil))
+ (sysdir (and system (component-pathname system)))
+ (truesysdir (truename* sysdir))
+ (impdir (lisp-implementation-directory))
+ (trueimpdir (truename* impdir)))
+ (and sysdir impdir
+ (or (subpathp sysdir impdir)
+ (subpathp truesysdir trueimpdir))))))
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.125: Another System Definition Facility.
+;;; This is ASDF 2.26.126: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
#:system-source-registry
#:user-source-registry-directory
#:system-source-registry-directory))
+
i #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl)))
`(,f ;; the fasl is the primary output, in first position
#+ecl ,@(unless (use-ecl-byte-compiler-p)
- (compile-file-pathname i :type :object))
+ `(,(compile-file-pathname i :type :object)))
#+mkcl ,(compile-file-pathname i :fasl-p nil) ;; object file
#+sbcl ,@(let ((s (component-system c)))
- (unless (or (builtin-system-p s) (equal (component-name s) "asdf"))
+ (unless (builtin-system-p s) ; includes ASDF itself
`(,(make-pathname :type "sbcl-warnings" :defaults f)))))))
(defmethod component-depends-on ((o compile-op) (c component))
(declare (ignorable o))
(defvar *compile-file-failure-behaviour*
(or #+(or mkcl sbcl) :error #+clisp :ignore :warn)
"How should ASDF react if it encounters a failure (per the ANSI spec of COMPILE-FILE)
-when compiling a file? Valid values are :error, :warn, and :ignore.
+when compiling a file, which includes any non-style-warning warning.
+Valid values are :error, :warn, and :ignore.
Note that ASDF ALWAYS raises an error if it fails to create an output file when compiling.")
;;; Condition control
+#+sbcl
+(progn
+ (defun sb-grovel-unknown-constant-condition-p (c)
+ (and (typep c 'sb-int:simple-style-warning)
+ (string-enclosed-p
+ "Couldn't grovel for "
+ (simple-condition-format-control c)
+ " (unknown to the C compiler).")))
+ (deftype sb-grovel-unknown-constant-condition ()
+ '(and style-warning (satisfies sb-grovel-unknown-constant-condition-p))))
+
(defvar *uninteresting-compiler-conditions*
(append
#+sbcl
- '(sb-c::simple-compiler-note
+ `(sb-c::simple-compiler-note
"&OPTIONAL and &KEY found in the same lambda list: ~S"
sb-int:package-at-variance
sb-kernel:uninteresting-redefinition
sb-kernel:undefined-alien-style-warning
- sb-ext:implicit-generic-function-warning
+ ;; sb-ext:implicit-generic-function-warning ; controversial, but let's allow it by default.
sb-kernel:lexical-environment-too-complex
- "Couldn't grovel for ~A (unknown to the C compiler)."
+ sb-grovel-unknown-constant-condition ; defined above.
;; BEWARE: the below four are controversial to include here.
sb-kernel:redefinition-with-defun
sb-kernel:redefinition-with-defgeneric
(funcall *output-translation-function*
(apply 'compile-file-pathname input-file keys)))))
-(defun* compile-file* (input-file &rest keys
- &key compile-check output-file warnings-file
- #+(or ecl mkcl) object-file
- &allow-other-keys)
+(defun* (compile-file*) (input-file &rest keys
+ &key compile-check output-file warnings-file
+ #+(or ecl mkcl) object-file
+ &allow-other-keys)
"This function provides a portable wrapper around COMPILE-FILE.
It ensures that the OUTPUT-FILE value is only returned and
the file only actually created if the compilation was successful,
On implementations that erroneously do not recognize standard keyword arguments,
it will filter them appropriately."
(let* ((keywords (remove-plist-keys
- `(:compile-check :warnings-file
+ `(:compile-check :warnings-file #+(or ecl mkcl) :object-file
#+gcl<2.7 ,@'(:external-format :print :verbose)) keys))
(output-file (apply 'compile-file-pathname* input-file :output-file output-file keywords))
#+ecl
(or object-file
(compile-file-pathname output-file :fasl-p nil)))
(tmp-file (tmpize-pathname output-file)))
+ #+ecl (when (and object-file (equal (compile-file-type) (pathname object-file)))
+ (format t "Whoa, funky upgrade API switching happening in ~S with ~S ~S~%"
+ 'compile-file* output-file object-file)
+ (rotatef output-file object-file))
(multiple-value-bind (output-truename warnings-p failure-p)
(with-saved-deferred-warnings (warnings-file)
(or #-(or ecl mkcl) (apply 'compile-file input-file :output-file tmp-file keywords)
(defgeneric* operate (operation component &key &allow-other-keys))
(define-convenience-action-methods
operate (operation component &key)
+ :operation-initargs t ;; backward-compatibility with ASDF1. Yuck.
:if-no-component (error 'missing-component :requires component))
(defvar *systems-being-operated* nil
(unless (version-satisfies component version)
(error 'missing-component-of-version :requires component :version version))
;; Before we operate on any system, make sure ASDF is up-to-date,
- ;; for if an upgrade is attempted at any later time, there may be trouble.
- ;; If we upgraded, restart the OPERATE from scratch,
- ;; for the function will have been redefined,
- ;; maybe from a new symbol for it may have been uninterned.
- (if (upgrade-asdf)
- (apply 'symbol-call :asdf 'operate operation component args)
- (let ((plan (apply 'traverse operation system args)))
- (perform-plan plan)
- (values operation plan)))))
+ ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
+ (unless systems-being-operated
+ (let ((operation-name (reify-symbol (type-of operation)))
+ (component-path (component-find-path component)))
+ (when (upgrade-asdf)
+ ;; If we were upgraded, restart OPERATE the hardest of ways, for
+ ;; its function may have been redefined, its symbol uninterned, its package deleted.
+ (return-from operate
+ (apply (find-symbol* 'operate :asdf)
+ (unreify-symbol operation-name)
+ component-path args)))))
+ (let ((plan (apply 'traverse operation system args)))
+ (perform-plan plan)
+ (values operation plan))))
(defun* oos (operation component &rest args &key &allow-other-keys)
(apply 'operate operation component args))
spec)
(defmethod find-operation (context (spec symbol))
(apply 'make-operation spec (operation-original-initargs context)))
-(defmethod operation-original-initargs ((context null)) context)
+(defmethod operation-original-initargs ((context symbol))
+ (declare (ignorable context))
+ nil)
(defclass build-op (operation) ())
(defun* getcwd ()
"Get the current working directory as per POSIX getcwd(3), as a pathname object"
- (or ;; missing: abcl gcl genera
+ (or #+abcl (parse-native-namestring
+ (java:jstatic "getProperty" "java.lang.System" "user.dir") :ensure-directory t)
#+allegro (excl::current-directory)
#+clisp (ext:default-directory)
#+clozure (ccl:current-directory)
(nth-value 1 (unix:unix-current-directory)) :ensure-directory t)
#+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
#+ecl (ext:getcwd)
- #+gcl (parse-native-namestring
+ #+gcl (parse-native-namestring ;; this is a joke. Isn't there a better way?
(first (symbol-call :asdf/driver :run-program/ '("/bin/pwd") :output :lines)))
+ #+genera *default-pathname-defaults* ;; on a Lisp OS, it *is* canonical!
#+lispworks (system:current-directory)
#+mkcl (mk-ext:getcwd)
#+sbcl (parse-native-namestring (sb-unix:posix-getcwd/))
(when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))
(ensure-package-unused p)
(delete-package package))))
- (defun fresh-package-name (&optional (prefix :%TO-BE-DELETED)
+ (defun fresh-package-name (&key (prefix :%TO-BE-DELETED)
+ separator
(index (random most-positive-fixnum)))
(loop :for i :from index
- :for n = (format nil "~A-~D" prefix i)
+ :for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i)
:thereis (and (not (find-package n)) n)))
- (defun rename-package-away (p)
+ (defun rename-package-away (p &rest keys &key prefix &allow-other-keys)
(rename-package
- p (fresh-package-name (format nil "__~A__" (package-name p)) 0)))
+ p (apply 'fresh-package-name :prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
(defun package-names (package)
(cons (package-name package) (package-nicknames package)))
(defun packages-from-names (names)
(let* ((sp (symbol-package symbol))
(in (gethash name inherited))
(xp (and status (symbol-package existing))))
+ (when (null sp)
+ (fishy :import-uninterned name (package-name p) mix)
+ (import symbol p)
+ (setf sp (package-name p)))
(cond
((gethash name shadowed))
(in
(delete-file x)))
;;; Translate a pathname
-(defun* translate-pathname* (path absolute-source destination &optional root source)
+(defun* (translate-pathname*) (path absolute-source destination &optional root source)
(declare (ignore source))
(cond
((functionp destination)
#:planned-action-count #:planned-output-action-count #:visited-actions
#:visiting-action-set #:visiting-action-list #:plan-actions-r
#:required-components #:filtered-sequential-plan
+ #:plan-system
#:plan-action-filter #:plan-component-type #:plan-keep-operation #:plan-keep-component
#:traverse-actions #:traverse-sub-actions))
(in-package :asdf/plan)
+;;;; Generic plan traversal class
+
+(defclass plan-traversal ()
+ ((system :initform nil :initarg :system :accessor plan-system)
+ (forced :initform nil :initarg :force :accessor plan-forced)
+ (forced-not :initform nil :initarg :force-not :accessor plan-forced-not)
+ (total-action-count :initform 0 :accessor plan-total-action-count)
+ (planned-action-count :initform 0 :accessor plan-planned-action-count)
+ (planned-output-action-count :initform 0 :accessor plan-planned-output-action-count)
+ (visited-actions :initform (make-hash-table :test 'equal) :accessor plan-visited-actions)
+ (visiting-action-set :initform (make-hash-table :test 'equal) :accessor plan-visiting-action-set)
+ (visiting-action-list :initform () :accessor plan-visiting-action-list)))
+
+
;;;; Planned action status
(defgeneric* plan-action-status (plan operation component)
(with-slots (stamp done-p planned-p) status
(format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p :planned-p planned-p))))
+(defmethod action-planned-p (action-status)
+ (declare (ignorable action-status)) ; default method for non planned-action-status objects
+ t)
+
;; TODO: eliminate NODE-FOR, use CONS.
;; Supposes cleaner protocol for operation initargs passed to MAKE-OPERATION.
;; However, see also component-operation-time and mark-operation-done
t))))
(defmethod action-forced-p (plan operation component)
- (and (action-override-p plan operation component 'plan-forced)
- (not (builtin-system-p (component-system component)))))
+ (and
+ ;; Did the user ask us to re-perform the action?
+ (action-override-p plan operation component 'plan-forced)
+ ;; You really can't force a builtin system and :all doesn't apply to it,
+ ;; except it it's the specifically the system currently being built.
+ (not (let ((system (component-system component)))
+ (and (builtin-system-p system)
+ (not (eq system (plan-system plan))))))))
+
(defmethod action-forced-not-p (plan operation component)
- (and (action-override-p plan operation component 'plan-forced-not)
- (not (action-forced-p plan operation component))))
+ (and
+ ;; Did the user ask us to not re-perform the action?
+ (action-override-p plan operation component 'plan-forced-not)
+ ;; Force takes precedence over force-not
+ (not (action-forced-p plan operation component))))
+
(defmethod action-forced-p ((plan null) operation component)
(declare (ignorable plan operation component))
nil)
+
(defmethod action-forced-not-p ((plan null) operation component)
(declare (ignorable plan operation component))
nil)
(defgeneric call-while-visiting-action (plan operation component function)
(:documentation "Detect circular dependencies"))
-(defclass plan-traversal ()
- ((forced :initform nil :initarg :force :accessor plan-forced)
- (forced-not :initform nil :initarg :force-not :accessor plan-forced-not)
- (total-action-count :initform 0 :accessor plan-total-action-count)
- (planned-action-count :initform 0 :accessor plan-planned-action-count)
- (planned-output-action-count :initform 0 :accessor plan-planned-output-action-count)
- (visited-actions :initform (make-hash-table :test 'equal) :accessor plan-visited-actions)
- (visiting-action-set :initform (make-hash-table :test 'equal) :accessor plan-visiting-action-set)
- (visiting-action-list :initform () :accessor plan-visiting-action-list)))
-
(defmethod initialize-instance :after ((plan plan-traversal)
&key (force () fp) (force-not () fnp) system
&allow-other-keys)
;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
-(defgeneric* traverse (operation component &key &allow-other-keys)
+(defgeneric* (traverse) (operation component &key &allow-other-keys)
(:documentation
"Generate and return a plan for performing OPERATION on COMPONENT.
(defmethod initialize-instance :after ((plan filtered-sequential-plan)
&key (force () fp) (force-not () fnp)
- system other-systems)
+ other-systems)
(declare (ignore force force-not))
- (with-slots (forced forced-not action-filter) plan
+ (with-slots (forced forced-not action-filter system) plan
(unless fp (setf forced (normalize-forced-systems (if other-systems :all t) system)))
(unless fnp (setf forced-not (normalize-forced-systems (if other-systems nil :all) system)))
(setf action-filter (ensure-function action-filter))))
(defvar *source-registry-parameter* nil)
(defun* initialize-source-registry (&optional (parameter *source-registry-parameter*))
- ;; In case we haven't upgraded ASDF yet, and it appears in the registry,
- ;; clear the upgrade attempt flag:
- (setf *asdf-upgrade-already-attempted* (not *upgraded-p*))
;; Record the parameter used to configure the registry
(setf *source-registry-parameter* parameter)
;; Clear the previous registry database:
(:export
#:system #:proto-system
#:system-source-file #:system-source-directory #:system-relative-pathname
- #:reset-system #:builtin-system-p
+ #:reset-system
#:system-description #:system-long-description
#:system-author #:system-maintainer #:system-licence #:system-license
- #:find-system ;; forward-reference, defined in find-system
- #:system-defsystem-depends-on))
+ #:system-defsystem-depends-on
+ #:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system
(in-package :asdf/system)
(defgeneric* find-system (system &optional error-p))
(defgeneric* system-source-file (system)
(:documentation "Return the source file in which system is defined."))
+(defgeneric* builtin-system-p (system))
;;;; The system class
(system-source-directory system))
-;;;; Beware of builtin systems
-(defgeneric* builtin-system-p (system))
-(defmethod builtin-system-p ((s system))
- (let* ((system (find-system s nil))
- (sysdir (and system (component-pathname system)))
- (truesysdir (truename* sysdir))
- (impdir (lisp-implementation-directory))
- (trueimpdir (truename* impdir)))
- (and sysdir impdir
- (or (subpathp sysdir impdir)
- (subpathp truesysdir trueimpdir)))))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(in-package :asdf-test)
(load-asdf)
(setf (logical-pathname-translations "ASDFTEST") nil))
(remhash "test-system" asdf::*defined-systems*)))
-(with-test ()
+(progn
(asdf:initialize-source-registry)
(format t "source registry: ~S~%" (hash-table->alist asdf::*source-registry*))
(asdf:initialize-output-translations)
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
;;; TODO: write tests for run-program/ instead -- and/or
;;; import those from the original xcvb-driver-test
;;; test asdf run-shell-command function
-(with-test ()
+(progn
(when (asdf::os-unix-p)
(setf asdf::*verbose-out* nil)
(assert-equal 1 (asdf:run-shell-command "false"))
fi
lisp=${1:-sbcl} ; shift
-if [ -z "$*" ]; then
- scripts="*.script"
-else
- scripts="$*"
-fi
-sok=1
-
-DO () { ( set -x ; "$@" ); }
+ECHO () { printf '%s\n' "$*" ;}
+ECHOn () { printf '%s' "$*" ;}
+DBG () { ECHO "$*" >& 2 ;}
+simple_term_p () {
+ case "$1" in *[!a-zA-Z0-9-+_,.:=%/]*) return 1 ;; *) return 0 ;; esac
+}
+kwote0 () { ECHOn "$1" | sed -e "s/\([\\\\\"\$\`]\)/\\\\\\1/g" ;}
+kwote1 () { if simple_term_p "$1" ; then ECHOn "$1"
+ else ECHOn "\"$(kwote0 "$1")\"" ; fi ;}
+kwote () { ( set +x
+ k="" ; for i ; do ECHOn "$k" ; kwote1 "$i" ; k=" " ; done ; echo
+) }
+DO () { kwote "$@" ; "$@" ; }
do_tests() {
- command="$1" eval="$2"
+ if [ -z "$*" ]; then
+ scripts="*.script"
+ else
+ scripts="$*"
+ fi
env | grep -i asdf
rm -f ~/.cache/common-lisp/"`pwd`"/* || true
- ( cd .. && DO $command $eval '(or #.(load "test/script-support.lisp") #.(asdf-test::compile-asdf-script))' )
+ ( cd .. && DO $cmd $debugp $eval '(or #.(load "test/script-support.lisp") #.(asdf-test::compile-asdf-script))' )
if [ $? -ne 0 ] ; then
echo "Compilation FAILED" >&2
+ echo "you can retry compilation with:" >&2
+ echo ./test/run-tests.sh $lisp >&2
+ echo "or more interactively (and maybe with rlwrap or in emacs), start with:" >&2
+ echo "$cmd" >&2
+ echo "then copy/paste:" >&2
+ echo '(load "test/script-support.lisp") (asdf-test::compile-asdf-script)' >&2
else
echo "Compiled OK" >&2
test_count=0
echo "Testing: $i" >&2
test_count=`expr "$test_count" + 1`
rm -f ~/.cache/common-lisp/"`pwd`"/* || true
- if DO $command $eval "(load \"$i\")" ; then
+ if DO $cmd $debugp $eval "(load \"script-support.lisp\")" $eval "(asdf-test::with-test () (load \"$i\"))" ; then
echo "Using $command, $i passed" >&2
test_pass=`expr "$test_pass" + 1`
else
echo "Using $command, $i failed" >&2
test_fail=`expr "$test_fail" + 1`
failed_list="$failed_list $i"
- sok=0
+ echo "you can retry compilation with:" >&2
+ echo ./test/run-tests.sh $lisp $i >&2
+ echo "or more interactively (and maybe with rlwrap or in emacs), start with:" >&2
+ echo "(cd test ; $cmd )" >&2
+ echo "then copy/paste:" >&2
+ echo "'(#.(load \"script-support.lisp\") #.(asdf-test::da) #.(asdf-test::with-test () (load \"$i\")))" >&2
fi
echo >&2
echo >&2
export CL_SOURCE_REGISTRY="${ASDFDIR}"
export ASDF_OUTPUT_TRANSLATIONS="(:output-translations (\"${ASDFDIR}\" (\"${ASDFDIR}/build/fasls\" :implementation)) :ignore-inherited-configuration)"
-
cmd="$command $flags"
+debugp=
if [ -z "${DEBUG_ASDF_TEST}" ] ; then
- cmd="$cmd $nodebug"
+ debugp="$nodebug"
fi
if valid_upgrade_test_p $lisp $tag $method ; then
echo "Testing ASDF upgrade from ${tag} using method $method"
extract_tagged_asdf $tag
- $cmd $eval \
+ $cmd $debugp $eval \
"'(#.(load\"$su\")#.(in-package :asdf-test)#.(test-upgrade $method \"$tag\"))" ||
{ echo "upgrade FAILED for $lisp from $tag using method $method" ;
echo "you can retry just that test with:" ;
echo ASDF_UPGRADE_TEST_TAGS=\"$tag\" ADSF_UPGRADE_TEST_METHODS=\"$method\" ./test/run-tests.sh -u $lisp ;
echo "or more interactively (and maybe with rlwrap or in emacs), start with:"
- echo "$command"
+ echo "$cmd"
echo "then copy/paste:"
echo "(load\"$su\") (da) (test-upgrade $method \"$tag\")"
exit 1 ;}
mkdir -p ../build/results
echo failure > ../build/results/status
thedate=`date "+%Y-%m-%d"`
- do_tests "$cmd" "$eval" 2>&1 | \
+ do_tests "$@" 2>&1 | \
tee "../build/results/${lisp}.text" "../build/results/${lisp}-${thedate}.save"
read a < ../build/results/status
clean_up
elif [ -n "$upgrade" ] ; then
run_upgrade_tests
else
- run_tests
+ run_tests "$@"
fi
#:assert-compare
#:assert-equal
#:leave-test #:def-test-system
+ #:test-source #:test-fasl #:resolve-output #:output-location
#:quietly))
(in-package :asdf-test)
`(;; If you want to trace some stuff while debugging ASDF,
;; here's a nice place to say what.
;; These string designators will be interned in ASDF after it is loaded.
+
+ ;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*)
))
(defvar *debug-asdf* nil)
(defvar *quit-when-done* t)
-(defun verbose (&optional (verbose t))
- (loop :for v :in '(*load-verbose* *compile-verbose*
- *load-print* *compile-print*)
- :do (setf (symbol-value v) verbose)))
+(defun verbose (&optional (verbose t) (print verbose))
+ (setf *load-verbose* verbose *compile-verbose* verbose)
+ (setf *load-print* print *compile-print* print))
(verbose nil)
;;; Test helper functions
(load (debug-lisp))
+(verbose t nil)
(defmacro assert-compare (expr)
(destructuring-bind (op x y) expr
(loop :for key :being :the :hash-keys :of table :using (:hash-value value)
:collect (cons key value)))
-
(defun exit-lisp (&optional (code 0)) ;; Simplified from asdf/image:quit
(finish-outputs*)
#+(or abcl xcl) (ext:quit :status code)
(defun test-upgrade (old-method new-method tag) ;; called by run-test
(with-test ()
+ #+clisp (trace compile-file load)
(when old-method
(cond
((string-equal tag "REQUIRE")
(assert (eval (intern (symbol-name '#:*file1*) :test-package)))
(assert (eval (intern (symbol-name '#:*file3*) :test-package)))))
+(defun output-location (&rest sublocation)
+ (list* *asdf-directory* "build/fasls" :implementation sublocation))
+(defun resolve-output (&rest sublocation)
+ (acall :resolve-location (apply 'output-location sublocation)))
+
+(defun test-source (file)
+ (acall :subpathname *test-directory* file))
+(defun test-output-dir ()
+ (resolve-output "asdf" "test"))
+(defun test-output (file)
+ (acall :subpathname (test-output-dir) file))
+(defun test-fasl (file)
+ (acall :compile-file-pathname* (test-source file)))
+
(defun configure-asdf ()
(setf *debug-asdf* (or *debug-asdf* (acall :getenvp "DEBUG_ASDF_TEST")))
(untrace)
`(:source-registry :ignore-inherited-configuration))
(acall :initialize-output-translations
`(:output-translations
- ((,*asdf-directory* :**/ :*.*.*) (,*asdf-directory* "build/fasls" :implementation "asdf"))
- (t (,*asdf-directory* "build/fasls" :implementation "root"))
+ ((,*asdf-directory* :**/ :*.*.*) ,(output-location "asdf"))
+ (t ,(output-location "root"))
:ignore-inherited-configuration))
(set (asym :*central-registry*) `(,*test-directory*))
(set (asym :*verbose-out*) *standard-output*)
It depends on the DBG macro in contrib/debug.lisp,
that you should load in your asdf/plan by inserting an (asdf-debug) form in it.
-#+DBG-ASDF (DBG :cas o c just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))
-|#
+#+DBG-ASDF (DBG :cas o c just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))|#
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(defun call-in-base-2 (thunk)
(let ((*read-base* 2))
(funcall thunk)))
-(with-test ()
+(progn
(def-test-system test-around-compile
:around-compile call-in-base-2
;; :depends-on ((:version :asdf "2.017.18")) ; no :around-compile before that.
(defpackage :test-asdf-system
- (:use :cl :asdf :asdf/driver))
+ (:use :cl :asdf))
(in-package :test-asdf-system)
+(defsystem :test-asdf
+ :components ())
+
(defsystem :test-asdf/test9-1
:version "1.1"
:components ((:file "file2"))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
;;(trace source-file-type)
-(with-test ()
+(progn
(format t "~D~%" (asdf:asdf-version))
(def-test-system test-builtin-source-file-type-1
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
+(in-package :asdf-test)
;;;---------------------------------------------------------------------------
;;; Check to see if the bundle functionality is doing something.
;;;---------------------------------------------------------------------------
-(with-test ()
- (asdf:initialize-source-registry '(:source-registry :ignore-inherited-configuration))
- (asdf:clear-system :test-bundle-1)
- (asdf:clear-system :test-bundle-2)
- (when (find-package :test-package) (delete-package :test-package))
- (eval `(def-test-system :test-bundle-1
- :pathname ,*test-directory*
- :components ((:file "file1") (:file "file3"))))
- (eval `(def-test-system :test-bundle-2
- :pathname ,*test-directory*
- :depends-on (:test-bundle-1) :components ((:file "file2"))))
- #-(or abcl (and ecl ecl-bytecmp) gcl)
- (let* ((op (make-instance 'asdf::fasl-op))
- (bundle-1 (asdf:output-file op (find-system :test-bundle-1)))
- (bundle-2 (asdf:output-file op (find-system :test-bundle-2))))
- (DBG :test-bundle bundle-1 bundle-2)
- (assert-equal (list bundle-2)
- (input-files (make-operation 'load-fasl-op) (find-system :test-bundle-2)))
- (delete-file-if-exists bundle-1)
- (delete-file-if-exists bundle-2)
- (operate 'load-fasl-op :test-bundle-2)
- ;; Check that the bundles were indeed created.
- (assert (probe-file bundle-2))
- (assert (probe-file bundle-1))
- ;; Check that the files were indeed loaded.
- (assert (symbol-value (find-symbol* :*file1* :test-package)))
- (assert (symbol-value (find-symbol* :*file3* :test-package)))))
+(asdf:initialize-source-registry '(:source-registry :ignore-inherited-configuration))
+(asdf:clear-system :test-bundle-1)
+(asdf:clear-system :test-bundle-2)
+(when (find-package :test-package) (delete-package :test-package))
+(def-test-system :test-bundle-1
+ :components ((:file "file1") (:file "file3")))
+(def-test-system :test-bundle-2
+ :depends-on (:test-bundle-1) :components ((:file "file2")))
+#+(or abcl (and ecl ecl-bytecmp) gcl)
+(leave-test "bundles not on this implementation" 0)
+
+(defparameter *bundle-1* (output-file 'fasl-op :test-bundle-1))
+(defparameter *bundle-2* (output-file 'fasl-op :test-bundle-2))
+(DBG :test-bundle *bundle-1* *bundle-2*)
+(assert-equal (list *bundle-2*)
+ (input-files 'load-fasl-op :test-bundle-2))
+(delete-file-if-exists *bundle-1*)
+(delete-file-if-exists *bundle-2*)
+(operate 'load-fasl-op :test-bundle-2)
+;; Check that the bundles were indeed created.
+(assert (probe-file *bundle-2*))
+(assert (probe-file *bundle-1*))
+;; Check that the files were indeed loaded.
+(assert (symbol-value (find-symbol* :*file1* :test-package)))
+(assert (symbol-value (find-symbol* :*file3* :test-package)))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
#-gcl<2.7
(assert (handler-case
(let ((asdf:*compile-file-failure-behaviour* :warn))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (def-test-system :test-concatenate-source
- :depends-on (:file3-only)
- :components
- ((:file "file2" :depends-on ("foo"))
- (:module "foo" :pathname ""
- :components ((:file "file1")
- (:file "file4" :if-feature (:not :common-lisp))))))
- (let ((mcso (make-operation 'monolithic-concatenate-source-op))
- (mccso (make-operation 'monolithic-compile-concatenated-source-op))
- (mlccso (make-operation 'monolithic-load-compiled-concatenated-source-op))
- (sys (find-system :test-concatenate-source)))
- (assert (operation-monolithic-p mcso))
- (assert-equal ;; on CLISP, we get un-equal pathnames with same namestrings. Sigh.
- (princ-to-string (input-files mcso sys))
- (princ-to-string (loop :for n :in '(3 1 2)
- :collect (subpathname *test-directory* (format nil "file~D.lisp" n)))))
- (assert-equal
- (output-file mcso sys)
- (apply-output-translations
- (subpathname *test-directory*
- "test-concatenate-source.all-systems.lisp")))
- (assert-equal
- (output-files mcso sys)
- (input-files mccso sys))
- (assert-equal ;; on ECL, we get un-equal pathnames.
- (princ-to-string (output-file mccso sys))
- (princ-to-string (apply-output-translations
- (compile-file-pathname
- (subpathname *test-directory*
- "test-concatenate-source.all-systems.lisp")))))
- (assert-equal
- (output-files mccso sys)
- (input-files mlccso sys))
- (operate 'monolithic-load-compiled-concatenated-source-op sys)
- (assert (symbol-value (find-symbol* :*file3* :test-package)))))
+(def-test-system :test-concatenate-source
+ :depends-on (:file3-only)
+ :components
+ ((:file "file2" :depends-on ("foo"))
+ (:module "foo" :pathname ""
+ :components ((:file "file1")
+ (:file "file4" :if-feature (:not :common-lisp))))))
+
+(defparameter mcso (make-operation 'monolithic-concatenate-source-op))
+(defparameter mccso (make-operation 'monolithic-compile-concatenated-source-op))
+(defparameter mlccso (make-operation 'monolithic-load-compiled-concatenated-source-op))
+(defparameter sys (find-system :test-concatenate-source))
+(assert (operation-monolithic-p mcso))
+(assert-equal ;; on CLISP, we get un-equal pathnames with same namestrings. Sigh.
+ (princ-to-string (input-files mcso sys))
+ (princ-to-string (loop :for n :in '(3 1 2)
+ :collect (test-source (format nil "file~D.lisp" n)))))
+(assert-equal
+ (output-file mcso sys)
+ (apply-output-translations
+ (subpathname *test-directory*
+ "test-concatenate-source.all-systems.lisp")))
+(assert-equal
+ (output-files mcso sys)
+ (input-files mccso sys))
+(assert-equal ;; on ECL, we get un-equal pathnames.
+ (princ-to-string (output-file mccso sys))
+ (princ-to-string (test-fasl "test-concatenate-source.all-systems.lisp")))
+(assert-equal
+ (output-files mccso sys)
+ (input-files mlccso sys))
+(operate 'monolithic-load-compiled-concatenated-source-op sys)
+(assert (symbol-value (find-symbol* :*file3* :test-package)))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(in-package :asdf)
:if-does-not-exist :create)
(format s "(defsystem :foo~D)~%" i))))
-(with-test ()
+(progn
(assert-equal (asdf::parse-output-translations-string "/foo:/bar::/baz:/quux")
'(:output-translations ("/foo" "/bar") :inherit-configuration
("/baz" "/quux")))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(defparameter *lambda-string* nil)
(eval `(assert-equal (string-char-codes ,*lambda-string*)
(expected-char-codes ',',encoding))))))
-(with-test ()
+(progn
(with-encoding-test (:utf-8)
(def-test-system :test-encoding-explicit-u8
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (asdf:operate 'asdf:load-op 'test-force)
+(asdf:operate 'asdf:load-op 'test-force)
- (let* ((file1 (asdf:compile-file-pathname* "file1"))
- (file1-date (file-write-date file1))
- (date1 (- file1-date 600))
- (date2 (- file1-date 300)))
+(defparameter file1 (test-fasl "file1"))
+(defparameter file1-date (file-write-date file1))
+(defparameter date1 (- file1-date 600))
+(defparameter date2 (- file1-date 300))
- (assert file1)
- (assert file1-date)
+(assert file1)
+(assert file1-date)
- ;; unforced, date should stay same
- (touch-file "test-force.asd" :timestamp date1)
- (touch-file "file1.lisp" :timestamp date1)
- (touch-file file1 :timestamp date2)
- (asdf:operate 'asdf:load-op 'test-force)
- (assert (equal (file-write-date file1) date2))
+;; unforced, date should stay same
+(touch-file "test-force.asd" :timestamp date1)
+(touch-file "file1.lisp" :timestamp date1)
+(touch-file file1 :timestamp date2)
+(asdf:operate 'asdf:load-op 'test-force)
+(assert (equal (file-write-date file1) date2))
- ;; forced, it should be later
- (asdf:operate 'asdf:load-op 'test-force :force t)
- (assert (>= (file-write-date file1) file1-date))))
+;; forced, it should be later
+(asdf:operate 'asdf:load-op 'test-force :force t)
+(assert (>= (file-write-date file1) file1-date))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
#+clisp
`(,*asdf-directory* "build/fasls" :implementation "logical-host-asdf")
:wilden t))))
-(with-test ()
+(progn
#-gcl<2.7
(DBG :logical
(logical-pathname-translations "ASDF")
;;; fasl when the source file is lost.
;;;---------------------------------------------------------------------------
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (def-test-system test-missing-lisp-file
- :components ((:file "file2" :in-order-to ((compile-op (load-op "fileMissing"))
- (load-op (load-op "fileMissing"))))
- (:file "fileMissing")))
- (let ((missing-name (namestring
- (make-pathname :name "fileMissing"
- :type "lisp"
- :defaults
- *test-directory*)))
- (template-file (namestring
- (make-pathname :name "file1"
- :type "lisp"
- :defaults
- *test-directory*))))
- (asdf::concatenate-files (list template-file) missing-name)
- (unless (probe-file missing-name)
- (format t "File copy failed.~%"))
- (asdf:operate 'asdf:load-op 'test-missing-lisp-file)
- ;; test that it compiled
- (let* ((file1 (asdf:compile-file-pathname* "file2"))
- (file2 (asdf:compile-file-pathname* "fileMissing"))
- (file1-date (file-write-date file1)))
-
- (assert file1-date)
- (assert (file-write-date file2))
-
- ;; and loaded
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
-
- ;; now remove the lisp file we created, and wait for an error
-
- (asdf::delete-file-if-exists missing-name)
- ;; we shouldn't be able to find the input-file for the compile-op, and that
- ;; should be an error.
- (let ((err (nth-value 1 (ignore-errors (asdf:operate 'asdf:load-op 'test-missing-lisp-file)))))
- (assert err)))))
+
+(def-test-system test-missing-lisp-file
+ :components ((:file "file2" :in-order-to ((compile-op (load-op "fileMissing"))
+ (load-op (load-op "fileMissing"))))
+ (:file "fileMissing")))
+
+(defparameter missing-name (test-source "fileMissing.lisp"))
+(defparameter template-file (test-source "file1.lisp"))
+(concatenate-files (list template-file) missing-name)
+(unless (probe-file missing-name)
+ (format t "File copy failed.~%"))
+
+(asdf:operate 'asdf:load-op 'test-missing-lisp-file)
+;; test that it compiled
+
+(defparameter file1 (test-fasl "file2"))
+(defparameter file2 (test-fasl "fileMissing"))
+(defparameter file1-date (file-write-date file1))
+
+(assert file1-date)
+(assert (file-write-date file2))
+
+;; and loaded
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
+
+;; now remove the lisp file we created, and wait for an error
+
+(delete-file-if-exists missing-name)
+;; we shouldn't be able to find the input-file for the compile-op, and that
+;; should be an error.
+(assert (nth-value 1 (ignore-errors (asdf:operate 'asdf:load-op 'test-missing-lisp-file))))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (asdf:load-system 'test-module-depend)
+(asdf:load-system 'test-module-depend)
- ;; test that it compiled
- (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)))
+;; test that it compiled
+(defparameter file1.fasl (test-fasl "file1"))
+(defparameter file2.fasl (test-fasl "file2"))
+(defparameter file3.fasl (test-fasl "file3"))
+(defparameter file1-date (file-write-date file1.fasl))
+(defparameter file3-date (file-write-date file3.fasl))
- (assert (and file1-date file3-date))
+(assert (and file1-date file3-date))
- ;; and loaded
- (assert (eval (intern (symbol-name '#:*file1*) :test-package)))
+;; and loaded
+(assert (eval (intern (symbol-name '#:*file1*) :test-package)))
- ;; 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.
+;; 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.
- (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))))
+(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 (test-fasl "file2")) file3-date))
+;; does this properly go to the second level?
+(assert (>= (file-write-date (test-fasl "file3")) file3-date))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
;;;---------------------------------------------------------------------------
;;; and reloading of "file2," but /not/ of system Y.
;;;---------------------------------------------------------------------------
-(with-test ()
-
- (def-test-system :test-module-excessive-depend
- :components ((:file "file1")
- (:module "quux"
- :pathname ""
- :depends-on ("file1")
- :components ((:file "file2")))))
+(def-test-system :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-quux ()
+ (find-component :test-module-excessive-depend "quux"))
- (defun find-file2 ()
- (find-component (find-quux) "file2"))
+(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 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)))
+(defmethod component-depends-on ((op compile-op)
+ (c (eql (find-file2))))
+ (cons `(load-op ,(find-system "file3-only"))
+ (call-next-method)))
- (DBG "loading test-module-excessive-depend"
- (operate 'load-op 'test-module-excessive-depend))
+(DBG "loading test-module-excessive-depend"
+ (operate 'load-op 'test-module-excessive-depend))
- ;; test that it compiled
- (let* ((file1 (compile-file-pathname* "file1"))
- (file2 (compile-file-pathname* "file2"))
- (file3 (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 ~
+;; test that it compiled
+(defparameter file1 (test-fasl "file1"))
+(defparameter file2 (test-fasl "file2"))
+(defparameter file3 (test-fasl "file3"))
+(defparameter file1-date (file-write-date file1))
+(defparameter file2-date (file-write-date file2))
+(defparameter 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~}"
- (mapcar #'cdr
- (remove-if #'car
- (pairlis (list file1-date file2-date file3-date)
- '("file1" "file2" "file3"))))))
+ (mapcar #'cdr
+ (remove-if #'car
+ (pairlis (list file1-date file2-date file3-date)
+ '("file1" "file2" "file3"))))))
- ;; and loaded
- (assert (eval (asdf::find-symbol* '#:*file1* :test-package)))
- (assert (eval (asdf::find-symbol* '#:*file3* :test-package)))
+;; and loaded
+(assert (eval (asdf::find-symbol* '#:*file1* :test-package)))
+(assert (eval (asdf::find-symbol* '#:*file3* :test-package)))
- ;; now touch file1 and check that file2 _is_ also recompiled
- ;; but that file3 is _not_ recompiled.
- ;; this will only work if the cross-module (intra-system)
- ;; dependency bug is fixed and the excessive compilation bug is fixed.
+;; now touch file1 and check that file2 _is_ also recompiled
+;; but that file3 is _not_ recompiled.
+;; this will only work if the cross-module (intra-system)
+;; dependency bug is fixed and the excessive compilation bug is fixed.
- (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))
+(defparameter 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)))
- (file3 (asdf:find-component :file3-only "file3")))
- #|(format t "~%Operation plan is:~%")(pprint plan)(terpri)|#
- (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 file1) before))
- (assert (>= (file-write-date file2) before)))
- (unless (= (file-write-date file3)
- file3-date)
- (error "Excessive compilation of file3.lisp: traverse bug."))))
+(defparameter plan (asdf::traverse
+ (make-instance 'asdf:load-op)
+ (asdf:find-system 'test-module-excessive-depend)))
+(defparameter file3 (asdf:find-component :file3-only "file3"))
+#|(format t "~%Operation plan is:~%")(pprint plan)(terpri)|#
+(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 file1) before))
+(assert (>= (file-write-date file2) before)))
+(unless (= (file-write-date file3)
+ file3-date)
+ (error "Excessive compilation of file3.lisp: traverse bug."))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(asdf:load-system 'test-module-pathnames)
(flet ((pathname-foo (x)
(list (or (normalize-pathname-directory-component (pathname-directory x)) '(:relative))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(in-package :asdf)
(use-package :asdf-test)
-(with-test ()
- (let* ((asd (subpathname *test-directory* "test-multiple.asd"))
- (tmp (subpathname *test-directory* "../build/"))
- (asd2 (subpathname tmp "test-multiple-too.asd"))
- (file4 (compile-file-pathname* "file4")))
- (setf *central-registry* `(,*test-directory* ,tmp))
- (run-shell-command
- (format nil "/bin/ln -sf ~A ~A 2>&1"
- (native-namestring asd)
- (native-namestring asd2)))
- (oos 'load-source-op 'test-multiple-too)
- (assert (symbol-value (asdf::find-symbol* :*file3* :test-package)))
- (load-system 'test-multiple-free)
- (assert (asdf::probe-file* file4))))
+(defparameter asd (subpathname *test-directory* "test-multiple.asd"))
+(defparameter tmp (subpathname *test-directory* "../build/"))
+(defparameter asd2 (subpathname tmp "test-multiple-too.asd"))
+(defparameter file4 (test-fasl "file4"))
+(setf *central-registry* `(,*test-directory* ,tmp))
+(run-program/
+ (format nil "/bin/ln -sf ~A ~A 2>&1"
+ (native-namestring asd)
+ (native-namestring asd2)))
+(oos 'load-source-op 'test-multiple-too)
+(assert (symbol-value (find-symbol* :*file3* :test-package)))
+(load-system 'test-multiple-free)
+(assert (probe-file* file4))
;;; check that added nesting via modules doesn't confuse ASDF
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(setf asdf:*central-registry* nil)
(load "test-nested-components-1.asd")
(print
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(in-package :cl-user)
(asdf-test::with-test ()
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(DBG :foo (current-lisp-file-pathname))
;;; -*- Lisp -*-
-(load "script-support.lisp")
-(load-asdf)
-(with-test ()
- (asdf:operate 'asdf:load-op 'test-redundant-recompile)
- ;; test that it compiled
- (let* ((file1 (asdf:compile-file-pathname* "file1"))
- (file2 (asdf:compile-file-pathname* "file2"))
- (file1-date (file-write-date file1))
- (file2-date (file-write-date file2)))
+(load-asdf)
- (format t "~&test-redundant-recompile 1: ~S ~S~%" file1 file1-date)
- (format t "~&test-redundant-recompile 2: ~S ~S~%" file2 file2-date)
- (assert file1-date)
- (assert file2-date)
+(asdf:operate 'asdf:load-op 'test-redundant-recompile)
+;; test that it compiled
+(defparameter file1 (test-fasl "file1"))
+(defparameter file2 (test-fasl "file2"))
+(defparameter file1-date (file-write-date file1))
+(defparameter file2-date (file-write-date file2))
- ;; and loaded
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
+(format t "~&test-redundant-recompile 1: ~S ~S~%" file1 file1-date)
+(format t "~&test-redundant-recompile 2: ~S ~S~%" file2 file2-date)
+(assert file1-date)
+(assert file2-date)
- ;; now rerun the load-op and check that no files are recompiled
+;; and loaded
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
- ;;(trace asdf::operation-done-p asdf::traverse)
- (asdf:operate 'asdf:load-op 'test-redundant-recompile)
- (assert (= file1-date (file-write-date file1)))
- (assert (= file2-date (file-write-date file2)))))
+;; now rerun the load-op and check that no files are recompiled
+(load-system 'test-redundant-recompile)
+(assert (= file1-date (file-write-date file1)))
+(assert (= file2-date (file-write-date file2)))
;;; test asdf:try-recompiling restart
-(load "script-support.lisp")
+
(load-asdf)
(defvar *caught-error* nil)
-(with-test ()
+(progn
(DBG "trlc1 1")
(asdf::delete-file-if-exists "try-reloading-dependency.asd")
(setf asdf::*defined-systems* (asdf::make-defined-systems-table))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (DBG "loading test-samedir-modules")
- (asdf:operate 'asdf:load-op 'test-samedir-modules)
- (let* ((file1 (asdf:compile-file-pathname* "file1"))
- (file2 (asdf:compile-file-pathname* "file2"))
- (file1-date (file-write-date file1)))
+(DBG "loading test-samedir-modules")
+(asdf:operate 'asdf:load-op 'test-samedir-modules)
+(defparameter file1 (test-fasl "file1"))
+(defparameter file2 (test-fasl "file2"))
+(defparameter file1-date (file-write-date file1))
- (DBG "test that it compiled" file1 file1-date)
- (assert file1-date)
- (assert (file-write-date file2))
+(DBG "test that it compiled" file1 file1-date)
+(assert file1-date)
+(assert (file-write-date file2))
- (DBG "and loaded")
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))))
+(DBG "and loaded")
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
;;(trace asdf::source-file-type asdf::source-file-explicit-type)
-(with-test ()
+(progn
(asdf:load-system 'test-source-file-type-1 :verbose t)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
(assert
make sure that serial t and static-files
don't cause full rebuilds all the time...
|#
-(load "script-support.lisp")
+
(load-asdf)
(in-package :asdf-test)
-(with-test ()
-
- (let ((s '(def-test-system static-and-serial
- :version "0.1"
- :serial t
- :components
- ((:static-file "file2.lisp")
- (:static-file "run-tests.sh")
- (:file "file1")))))
- (eval s)
- (load-test-system 'static-and-serial)
+(defparameter s
+ '(def-test-system static-and-serial
+ :version "0.1"
+ :serial t
+ :components
+ ((:static-file "file2.lisp")
+ (:static-file "run-tests.sh")
+ (:file "file1"))))
+(eval s)
+(load-test-system 'static-and-serial)
- (let* ((file1 (asdf:compile-file-pathname* "file1.lisp"))
- (file1-date (file-write-date file1))
- (date1 (- file1-date 600))
- (date2 (- file1-date 300))
- (date3 (- file1-date 150)))
+(defparameter file1 (test-fasl "file1.lisp"))
+(defparameter file1-date (file-write-date file1))
+(defparameter date1 (- file1-date 600))
+(defparameter date2 (- file1-date 300))
+(defparameter date3 (- file1-date 150))
- (assert file1-date)
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
- (format t "file: ~S~%date: ~S~%" file1 file1-date)
+(assert file1-date)
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
+(format t "file: ~S~%date: ~S~%" file1 file1-date)
- ;; date should stay same
- (clear-system 'static-and-serial)
- (delete-package :test-package)
- (eval s)
- (touch-file "file2.lisp" :timestamp date1)
- (touch-file "run-tests.sh" :timestamp date1)
- (touch-file "file1.lisp" :timestamp date2)
- (touch-file file1 :timestamp date3)
- (DBG "load again" (oos 'load-op 'static-and-serial))
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
- (assert-equal (file-write-date file1) date3))))
+;; date should stay same
+(clear-system 'static-and-serial)
+(delete-package :test-package)
+(eval s)
+(touch-file "file2.lisp" :timestamp date1)
+(touch-file "run-tests.sh" :timestamp date1)
+(touch-file "file1.lisp" :timestamp date2)
+(touch-file file1 :timestamp date3)
+(DBG "load again" (oos 'load-op 'static-and-serial))
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
+(assert-equal (file-write-date file1) date3)
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(asdf:initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(asdf:load-system :asdf)
(asdf:initialize-source-registry `(:source-registry (:directory ,*asdf-directory*) :ignore-inherited-configuration))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(asdf:load-system 'test-system-pathnames)
(assert (find-package :test-package)
() "package test-package not found")
;;; test system def reloading if touched
;;; system that can be found using *system-definition-search-functions*
-(load "script-support.lisp")
(load-asdf)
-(with-test ()
- (flet ((system-load-time (name)
- (let ((data (asdf::system-registered-p name)))
- (when data
- (car data)))))
- (let* ((file "test1.asd")
- (date1 (file-write-date file))
- (date2 (- date1 600))
- (date3 (- date1 300)))
- (touch-file file :timestamp date2)
- (asdf:find-system :test1)
- (let ((date4 (file-write-date (asdf::compile-file-pathname* "file1.lisp")))
- (date5 (system-load-time :test1)))
- (DBG :blah date2 date3 date4 date5)
- (assert-equal date2 date5)
- (assert (>= date4 date3))
- (sleep 1)
- (touch-file file)
- (asdf:find-system :test1)
- (let ((date6 (system-load-time :test1)))
- (assert (> date6 date4)))))))
-
\ No newline at end of file
+
+(defun system-load-time (name)
+ (if-let (data (asdf::system-registered-p name))
+ (car data)))
+(defparameter file "test1.asd")
+(defparameter date1 (file-write-date file))
+(defparameter date2 (- date1 600))
+(defparameter date3 (- date1 300))
+(touch-file file :timestamp date2)
+(asdf:find-system :test1)
+(defparameter date4 (file-write-date (test-fasl "file1.lisp")))
+(defparameter date5 (system-load-time :test1))
+(DBG :blah date2 date3 date4 date5)
+(assert-equal date2 date5)
+(assert (>= date4 date3))
+(sleep 1)
+(touch-file file)
+(find-system :test1)
+(defparameter date6 (system-load-time :test1))
+(assert (> date6 date4))
;;; test system definition reloading if touched
;;; system that canNOT be found using *system-definition-search-functions*
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(flet ((system-load-time (name)
(let ((data (asdf::system-registered-p name)))
(when data
;;; test asdf:try-recompiling restart
-(load "script-support.lisp")
+
(load-asdf)
-(defvar *caught-error* nil)
+(defparameter *caught-error* nil)
+
+(delete-file-if-exists (test-fasl "try-recompiling-1"))
+
+#-gcl
+(handler-bind
+ ((error (lambda (c)
+ (setf *caught-error* t)
+ (multiple-value-bind (name mode)
+ (find-symbol
+ (symbol-name 'try-recompiling)
+ :asdf)
+ (assert (eq mode :external))
+ (let ((restart (find-restart name c)))
+ #+(or)
+ ;; debug
+ (print (list c restart (compute-restarts c)))
+ (when restart
+ (invoke-restart restart)))))))
+ (oos 'load-op 'try-recompiling-1))
-(with-test ()
- (asdf::delete-file-if-exists (compile-file-pathname "try-recompiling-1"))
- #-gcl
- (handler-bind ((error (lambda (c)
- (setf *caught-error* t)
- (multiple-value-bind (name mode)
- (find-symbol
- (symbol-name 'try-recompiling)
- :asdf)
- (assert (eq mode :external))
- (let ((restart (find-restart name c)))
- #+(or)
- ;; debug
- (print (list c restart (compute-restarts c)))
- (when restart
- (invoke-restart restart)))))))
- (oos 'load-op 'try-recompiling-1))
- #-gcl
- (assert *caught-error*))
+#-gcl
+(assert *caught-error*)
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
#+scl
(require :http-library)
-(with-test ()
- ;; Compare the source files with local versions before loading them.
- #+(and (or abcl scl) trust-the-net)
- (flet ((compare (url local)
- (with-open-file (stream1 url :element-type 'character
- :external-format :utf-8)
- (with-open-file (stream2 local :element-type 'character
- :external-format :utf-8)
- (loop
- (let ((ch1 (read-char stream1 nil nil))
- (ch2 (read-char stream2 nil nil)))
- (unless (eql ch1 ch2)
- (error "Unexpected source content."))
- (unless (and ch1 ch2)
- (return))))))))
- (let* ((system (asdf:find-system "test-urls-1"))
- (url (asdf:component-pathname
- (asdf:find-component system "test"))))
- (compare url "test.lisp"))
+;; Compare the source files with local versions before loading them.
+#+(and (or abcl scl) trust-the-net)
+(flet ((compare (url local)
+ (with-open-file (stream1 url :element-type 'character
+ :external-format :utf-8)
+ (with-open-file (stream2 local :element-type 'character
+ :external-format :utf-8)
+ (loop
+ (let ((ch1 (read-char stream1 nil nil))
+ (ch2 (read-char stream2 nil nil)))
+ (unless (eql ch1 ch2)
+ (error "Unexpected source content."))
+ (unless (and ch1 ch2)
+ (return))))))))
+ (let* ((system (find-system "test-urls-1"))
+ (url (asdf:component-pathname
+ (asdf:find-component system "test"))))
+ (compare url "test.lisp"))
- (asdf:operate 'asdf:load-op 'test-urls-1)
+ (load-system 'test-urls-1)
- ;; test that it compiled
- (let* ((path (asdf:component-pathname
- (asdf:find-component "test-urls-1" "test")))
- (test (asdf:compile-file-pathname* path))
- (test-date (file-write-date test)))
- (format t "~&test-urls-1 1: ~S ~S~%" test test-date)
- (assert test-date))))
+ ;; test that it compiled
+ (let* ((path (component-pathname
+ (find-component "test-urls-1" "test")))
+ (test (test-fasl path))
+ (test-date (file-write-date test)))
+ (format t "~&test-urls-1 1: ~S ~S~%" test test-date)
+ (assert test-date)))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
#+scl
(require :http-library)
-(with-test ()
+(progn
(setf asdf:*central-registry* '("http://www.scieneer.com/files/"))
;; Compare the source files with local versions before loading them.
#+(and (or abcl scl) trust-the-net)
(error "Unexpected source content."))
(unless (and ch1 ch2)
(return))))))))
- (let ((url (asdf:system-definition-pathname "test-urls-2")))
+ (let ((url (system-definition-pathname "test-urls-2")))
(compare url "test-urls-2.asd"))
(let* ((system (asdf:find-system "test-urls-2"))
- (url (asdf:component-pathname
- (asdf:find-component system "test"))))
+ (url (component-pathname
+ (find-component system "test"))))
(compare url "test.lisp"))
- (asdf:operate 'asdf:load-op 'test-urls-2)
+ (load-system 'test-urls-2)
;; Test that it compiled
- (let* ((path (asdf:component-pathname
- (asdf:find-component "test-urls-2" "test")))
- (test (asdf:compile-file-pathname* path))
+ (let* ((path (component-pathname
+ (find-component "test-urls-2" "test")))
+ (test (test-fasl path))
(test-date (file-write-date test)))
(format t "~&test-urls-2 1: ~S ~S~%" test test-date)
(assert test-date))))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(in-package :asdf)
(use-package :asdf-test)
-(with-test ()
+(progn
(assert
(every #'directory-pathname-p
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(def-test-system :versioned-system-1
:pathname #.*test-directory*
:version "1.0")
+++ /dev/null
-(defsystem test-weakly-depends-on-present
- :weakly-depends-on (file3-only)
- :components ((:file "file1")))
-
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
;;;---------------------------------------------------------------------------
;;; directory, actually gets loaded.
;;;---------------------------------------------------------------------------
+(def-test-system test-weakly-depends-on-present
+ :weakly-depends-on (file3-only)
+ :components ((:file "file1")))
+
+(DBG "Loading" (operate 'load-op 'test-weakly-depends-on-present))
-(with-test ()
- (asdf:load-system 'test-weakly-depends-on-present)
- ;; The weakly-depended-on system, file3-only, should be loaded...
- (let* ((file3 (asdf:compile-file-pathname* "file3"))
- (file3-date (file-write-date file3)))
+(DBG "The weakly-depended-on system, file3-only, should be loaded...")
+(defparameter *file3* (test-fasl "file3"))
+(defparameter *file3-date* (file-write-date *file3*))
- ;; (format t "~&test1 1: ~S ~S~%" file1 file1-date)
- (assert file3-date)
- ;; and loaded
- (assert (symbol-value (find-symbol (symbol-name :*file3*) :test-package)))))
+(DBG "test1 1" *file3* *file3-date*)
+(assert *file3-date*)
+(assert (symbol-value (find-symbol (symbol-name :*file3*) :test-package)))
- ;; The depending system (test-weakly-depends-on-present) loads
- ;; successfully. [2011/12/14:rpg]
- (let* ((file1 (asdf:compile-file-pathname* "file1"))
- (file1-date (file-write-date file1)))
+(DBG "The depending system (test-weakly-depends-on-present) loads successfully. [2011/12/14:rpg]")
+(defparameter *file1* (test-fasl "file1"))
+(defparameter *file1-date* (file-write-date *file1*))
- ;; (format t "~&test1 1: ~S ~S~%" file1 file1-date)
- (assert file1-date)
- ;; and loaded
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))))
+(DBG "test1 2" *file1* *file1-date*)
+(assert *file1-date*)
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
;;; system will still load successfully. [2011/12/14:rpg]
;;;---------------------------------------------------------------------------
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (asdf:load-system 'test-weakly-depends-on-unpresent)
- ;; test that it compiled
- (let* ((file1 (asdf:compile-file-pathname* "file1"))
- (file1-date (file-write-date file1)))
+(asdf:load-system 'test-weakly-depends-on-unpresent)
+;; test that it compiled
+(defparameter file1 (test-fasl "file1"))
+(defparameter file1-date (file-write-date file1))
- (format t "~&test1 1: ~S ~S~%" file1 file1-date)
- (assert file1-date)
- ;; and loaded
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))))
+(format t "~&test1 1: ~S ~S~%" file1 file1-date)
+(assert file1-date)
+;; and loaded
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
#+gcl (trace load compile-file asdf:perform asdf::perform-plan)
-(with-test ()
+(progn
(let ((foo :test-asdf-location-change))
(DBG "load foo. Should load from xach-foo-1/")
(setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/")))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
(touch-file "test1.asd" :offset -3600) ;; touch test1.asd an hour ago.
(touch-file "file1.lisp" :offset -3500)
(touch-file "file2.lisp" :offset -3400)
-
-(with-test ()
- (DBG "loading test1")
- (asdf:load-system 'test1)
- (let* ((file1 (asdf:compile-file-pathname* "file1"))
- (file2 (asdf:compile-file-pathname* "file2"))
- (date (file-write-date "test1.asd"))
- (then (file-write-date file2)))
-
- (DBG "test that it compiled" date then)
- (assert (probe-file file1))
- (assert (probe-file file2))
-
- (DBG "and loaded")
- (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
-
- (DBG "now remove file2 that depends-on file1" date)
- (touch-file file1 :timestamp (+ date 500))
- (assert-equal (+ date 500) (file-write-date file1))
- (asdf::delete-file-if-exists file2)
-
- (DBG "load again")
- (asdf:clear-system 'test1)
- (asdf:load-system 'test1)
- (DBG "check that file1 is _not_ recompiled, but file2 is" (file-write-date file1))
- (assert-equal (+ date 500) (file-write-date file1))
- (assert-compare (<= then (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)))
- (touch-file "file1.lisp" :timestamp (+ date 3000)) ;; touch file1 a minute ago.
- (touch-file file2 :timestamp (+ date 2000)) ;; touch file2.fasl some time before.
- (asdf:clear-system 'test1)
- (asdf:operate 'asdf:load-op 'test1)
- (DBG :foo (file-write-date file2) before)
- (assert-compare (>= (file-write-date file2) before)))))
+(DBG "loading test1")
+(asdf:load-system 'test1)
+
+(defparameter *file1* (test-fasl "file1"))
+(defparameter *file2* (test-fasl "file2"))
+(defparameter *date* (file-write-date "test1.asd"))
+(defparameter *then* (file-write-date *file2*))
+
+(assert-equal *file1* (first (output-files 'compile-op '("test1" "file1"))))
+
+(DBG "test that it compiled" *date* *then*)
+(assert (probe-file *file1*))
+(assert (probe-file *file2*))
+
+(DBG "and loaded")
+(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
+
+(DBG "now remove file2 that depends-on file1" *date*)
+(touch-file *file1* :timestamp (+ *date* 500))
+(assert-equal (+ *date* 500) (file-write-date *file1*))
+(asdf::delete-file-if-exists *file2*)
+
+(DBG "load again")
+(asdf:clear-system 'test1)
+(asdf:load-system 'test1)
+(DBG "check that file1 is _not_ recompiled, but file2 is" (file-write-date *file1*))
+(assert-equal (+ *date* 500) (file-write-date *file1*))
+(assert-compare (<= *then* (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
+(defparameter *before* (file-write-date *file2*))
+(touch-file "file1.lisp" :timestamp (+ *date* 3000)) ;; touch file1 a minute ago.
+(touch-file *file2* :timestamp (+ *date* 2000)) ;; touch file2.fasl some time before.
+(asdf:clear-system 'test1)
+(asdf:operate 'asdf:load-op 'test1)
+(DBG :foo (file-write-date *file2*) *before*)
+(assert-compare (>= (file-write-date *file2*) *before*))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (DBG "test2: loading test2b1")
- (asdf:load-system 'test2b1)
- (DBG "test2: file3 and file4 were compiled")
- (assert (and (probe-file (asdf:compile-file-pathname* (truename "file3.lisp")))
- (probe-file (asdf:compile-file-pathname* (truename "file4.lisp")))))
- (DBG "test2: loading test2b2 should fail")
- #-gcl
- (handler-case
- (asdf:load-system 'test2b2)
- (asdf:missing-dependency (c)
- (format t "load failed as expected: - ~%~A~%" c))
- (:no-error (c)
- (declare (ignore c))
- (error "should have failed, oops")))
- (DBG "test2: loading test2b3 should fail")
- #-gcl
- (handler-case
- (asdf:load-system 'test2b3)
- (asdf:missing-dependency (c)
- (format t "load failed as expected: - ~%~A~%" c))
- (:no-error (c)
- (declare (ignore c))
- (error "should have failed, oops"))))
+
+(DBG "test2: loading test2b1")
+(asdf:load-system 'test2b1)
+
+(DBG "test2: file3 and file4 were compiled")
+(assert (and (probe-file (test-fasl "file3.lisp"))
+ (probe-file (test-fasl "file4.lisp"))))
+
+(DBG "test2: loading test2b2 should fail")
+#-gcl
+(handler-case
+ (asdf:load-system 'test2b2)
+ (asdf:missing-dependency (c)
+ (format t "load failed as expected: - ~%~A~%" c))
+ (:no-error (c)
+ (declare (ignore c))
+ (error "should have failed, oops")))
+
+(DBG "test2: loading test2b3 should fail")
+#-gcl
+(handler-case
+ (asdf:load-system 'test2b3)
+ (asdf:missing-dependency (c)
+ (format t "load failed as expected: - ~%~A~%" c))
+ (:no-error (c)
+ (declare (ignore c))
+ (error "should have failed, oops")))
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
- (let* ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp")))
- (fasl2 (asdf:compile-file-pathname* (truename "file2.lisp")))
- (ns1 (asdf::native-namestring fasl1))
- (ns2 (asdf::native-namestring fasl2)))
- (asdf:run-shell-command "rm -f ~A ~A" ns1 ns2)
- (DBG "should load file1 but not file2")
- (asdf:load-system :test3)
- (assert (probe-file fasl1))
- (assert (not (probe-file fasl2)))
- (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"))))
+(defparameter *fasl1* (test-fasl "file1.lisp"))
+(defparameter *fasl2* (test-fasl "file2.lisp"))
+
+(delete-file-if-exists *fasl1*)
+(delete-file-if-exists *fasl2*)
+(DBG "should load file1 but not file2")
+(asdf:load-system :test3)
+(assert (probe-file *fasl1*))
+(assert (not (probe-file *fasl2*)))
+
+(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"))
;;; make sure we get a missing-component error
-(load "script-support.lisp")
+
(load-asdf)
(in-package :asdf-test)
-(with-test ()
+(progn
(trace operate)
(handler-case
(asdf:oos 'asdf:load-op 'system-does-not-exist)
;;; make sure we get a missing-component-of-version error
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(handler-case
(load-test-system :test-asdf/test9-1)
(asdf:missing-component-of-version (c)
;;; -*- Lisp -*-
-(load "script-support.lisp")
+
(load-asdf)
-(with-test ()
+(progn
(load (asdf::subpathname *asdf-directory* "contrib/wild-modules.lisp"))
(def-test-system :wild-module
:version "0.0"
#:upgrade-asdf #:asdf-upgrade-error #:when-upgrade
#:*asdf-upgrade-already-attempted*
#:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
- #:asdf-version #:*upgraded-p*
+ #:asdf-version #:*upgraded-p* #:*asdf-version*
#:asdf-message #:*asdf-verbose* #:*verbose-out*
;; There will be no symbol left behind!
#:intern*)
(:import-from :asdf/package #:intern* #:find-symbol*))
(in-package :asdf/upgrade)
-;; Note that this massive package destruction makes it impossible
-;; to use asdf/driver on top of an old ASDF on these implementations
-(eval-when (:load-toplevel :compile-toplevel :execute)
- #+(or clisp xcl)
- (unless (let ((vs (find-symbol* 'version-satisfies :asdf nil))
- (av (find-symbol* 'asdf-version :asdf nil)))
- (and vs av (funcall vs (funcall av) "2.26.59")))
- (if-let (p (find-package :asdf))
- (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))))
-
;;; Special magic to detect if this is an upgrade
(eval-when (:load-toplevel :compile-toplevel :execute)
;; "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.125")
+ (asdf-version "2.26.126")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
- (already-there (equal asdf-version existing-version)))
- (unless (and existing-asdf already-there)
+ (already-there (equal asdf-version existing-version))
+ (redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops.
+ '(#:perform #:explain #:output-files #:operation-done-p
+ #:component-parent-pathname #:traverse
+ #:component-depends-on #:input-files
+ #:perform-with-restarts #:component-relative-pathname
+ #:system-source-file #:operate #:find-component #:find-system
+ #:apply-output-translations
+ #:system-relative-pathname
+ #:inherit-source-registry #:process-source-registry
+ #:process-source-registry-directive #:source-file-type
+ #:process-output-translations-directive
+ #:trivial-system-p
+ ))
+ (uninterned-symbols
+ '(#:*asdf-revision* #:around #:asdf-method-combination
+ #:split #:make-collector #:do-dep #:do-one-dep
+ #:resolve-relative-location-component #:resolve-absolute-location-component
+ #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function
+ (when (and existing-asdf (not already-there))
(when existing-asdf
(asdf-message "~&; Upgrading ASDF ~@[from version ~A ~]to version ~A~%"
- existing-version asdf-version))
- (unless already-there
+ existing-version asdf-version)
(push existing-version *upgraded-p*))
- (setf *asdf-version* asdf-version))))
+ ;;(format t "UPGRADE FROBBING! ~S~%" (list existing-asdf existing-version asdf-version)) ;XXX
+ (loop :for name :in (append #-(or clisp ecl) redefined-functions)
+ :for sym = (find-symbol* name :asdf nil) :do
+ (when sym
+ ;;(format t "Undefining ~S~%" sym);XXX
+ (fmakunbound sym)))
+ (loop :with asdf = (find-package :asdf)
+ :for name :in (append #+(or clisp ecl) redefined-functions uninterned-symbols) ;XXX
+ :for sym = (find-symbol* name :asdf nil)
+ :for base-pkg = (and sym (symbol-package sym)) :do
+ (when sym
+ ;;(format t "frobbing symbol ~S~%" sym);XXX
+ (cond
+ ((or (eq base-pkg asdf) (not base-pkg))
+ (unintern* sym asdf)
+ (intern* sym asdf))
+ (t
+ (unintern* sym base-pkg)
+ (let ((new (intern* sym base-pkg)))
+ (shadowing-import new asdf))))))
+ ;; Note that this massive package destruction makes it impossible
+ ;; to use asdf/driver on top of an old ASDF on these implementations
+ #+(or clisp xcl)
+ (let ((p (find-package :asdf)))
+ (when p
+ (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))
+ (rename-package-away p :prefix (format nil "~A-~A" :asdf (or existing-version :1.x))
+ :index 0 :separator "-"))))
+ (setf *asdf-version* asdf-version)))
;;; Upgrade interface
;;; Self-upgrade functions
-(defvar *asdf-upgrade-already-attempted* nil)
-
(defvar *post-upgrade-cleanup-hook* ())
(defvar *post-upgrade-restart-hook* ())
(defun* upgrade-asdf ()
"Try to upgrade of ASDF. If a different version was used, return T.
We need do that before we operate on anything that may possibly depend on ASDF."
- (unless *asdf-upgrade-already-attempted*
- (setf *asdf-upgrade-already-attempted* t)
- (let ((version (asdf-version)))
- (handler-bind (((or style-warning warning) #'muffle-warning))
- (symbol-call :asdf :load-system :asdf :verbose nil))
- (cleanup-upgraded-asdf version))))
+ (let ((version (asdf-version))
+ (*load-print* nil)
+ (*compile-print* nil))
+ (handler-bind (((or style-warning warning) #'muffle-warning))
+ (symbol-call :asdf :load-system :asdf :verbose nil))
+ (cleanup-upgraded-asdf version)))
(macrolet
((defdef (def* def)
`(defmacro ,def* (name formals &rest rest)
- `(progn
+ (destructuring-bind (name &key (supersede t))
+ (if (or (atom name) (eq (car name) 'setf))
+ (list name :supersede nil)
+ name)
+ (declare (ignorable supersede))
+ `(progn
;; undefining the previous function is the portable way
- ;; of overriding any incompatible previous gf, but somehow
- ;; this causes CLISP to fail to see COMPONENT-NAME methods after ugprade
- ;; so instead, for CLISP we delete-package* in package.lisp
- ;; any time the API changes.
- #-clisp
- (undefine-function ',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))))
- (,',def ,name ,formals ,@rest)))))
+ ;; of overriding any incompatible previous gf,
+ ;; but we usually try to do it only for the functions that need it,
+ ;; which happens in asdf/upgrade - however, for ECL, we need this hammer,
+ ;; (which causes issues in clisp)
+ #-ecl ;XXX
+ ,@(when (or supersede #+(or (and gcl (not gcl-pre2.7))) t)
+ `((undefine-function ',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))))
+ (,',def ,name ,formals ,@rest))))))
(defdef defgeneric* defgeneric)
(defdef defun* defun))
common-lisp.net / projects/asdf/asdf.git / commitdiff
