Commit 67d8d7df authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.129: adding warnings file support for CCL.

parent cab5dfa1
...@@ -18,6 +18,7 @@ ...@@ -18,6 +18,7 @@
#:component-operation-time #:mark-operation-done #:compute-action-stamp #:component-operation-time #:mark-operation-done #:compute-action-stamp
#:perform #:perform-with-restarts #:retry #:accept #:feature #:perform #:perform-with-restarts #:retry #:accept #:feature
#:traverse-actions #:traverse-sub-actions #:required-components ;; in plan #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
#:action-path #:find-action
)) ))
(in-package :asdf/action) (in-package :asdf/action)
...@@ -27,6 +28,12 @@ ...@@ -27,6 +28,12 @@
(defgeneric* traverse-sub-actions (operation component &key &allow-other-keys)) (defgeneric* traverse-sub-actions (operation component &key &allow-other-keys))
(defgeneric* required-components (component &key &allow-other-keys)) (defgeneric* required-components (component &key &allow-other-keys))
;;;; Reified representation for storage or debugging. Note: dropping original-initags
(defun action-path (action)
(destructuring-bind (o . c) action (cons (type-of o) (component-find-path c))))
(defun find-action (path)
(destructuring-bind (o . c) path (cons (make-operation o) (find-component () c))))
;;;; Convenience methods ;;;; Convenience methods
(defmacro define-convenience-action-methods (defmacro define-convenience-action-methods
......
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.128" ;; to be automatically updated by make bump-version :version "2.26.129" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
:components ((:module "build" :components ((:file "asdf")))) :components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem)))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
......
...@@ -235,6 +235,10 @@ directive.") ...@@ -235,6 +235,10 @@ directive.")
:wilden (and wilden (not (pathnamep x))) :wilden (and wilden (not (pathnamep x)))
:want-absolute t)) :want-absolute t))
;; Try to override declaration in previous versions of ASDF.
(declaim (ftype (function (t &key (:directory boolean) (:wilden boolean)
(:ensure-directory boolean)) t) resolve-location))
(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. (when directory (setf ensure-directory t)) ;; :directory backward compatibility, until 2014-01-16.
(if (atom x) (if (atom x)
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.128: Another System Definition Facility. ;;; This is ASDF 2.26.129: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -81,7 +81,7 @@ ...@@ -81,7 +81,7 @@
(outputs (output-files o c))) (outputs (output-files o c)))
(multiple-value-bind (output warnings-p failure-p) (multiple-value-bind (output warnings-p failure-p)
(destructuring-bind (destructuring-bind
(output-file &optional #+(or ecl mkcl) object-file #+sbcl warnings-file) outputs (output-file &optional #+(or ecl mkcl) object-file #+(or clozure sbcl) warnings-file) outputs
(call-with-around-compile-hook (call-with-around-compile-hook
c #'(lambda (&rest flags) c #'(lambda (&rest flags)
(with-muffled-compiler-conditions () (with-muffled-compiler-conditions ()
...@@ -90,7 +90,7 @@ ...@@ -90,7 +90,7 @@
:external-format (component-external-format c) :external-format (component-external-format c)
(append (append
#+(or ecl mkcl) (list :object-file object-file) #+(or ecl mkcl) (list :object-file object-file)
#+sbcl (list :warnings-file warnings-file) #+(or clozure sbcl) (list :warnings-file warnings-file)
flags (compile-op-flags o))))))) flags (compile-op-flags o)))))))
(check-lisp-compile-results output warnings-p failure-p (check-lisp-compile-results output warnings-p failure-p
"~/asdf-action::format-action/" (list (cons o c)))))) "~/asdf-action::format-action/" (list (cons o c))))))
...@@ -114,12 +114,15 @@ ...@@ -114,12 +114,15 @@
(f (compile-file-pathname (f (compile-file-pathname
i #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl))) i #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl)))
`(,f ;; the fasl is the primary output, in first position `(,f ;; the fasl is the primary output, in first position
#+ecl ,@(unless (use-ecl-byte-compiler-p) #+(or clozure sbcl)
`(,(compile-file-pathname i :type :object))) ,@(let ((s (component-system c)))
#+mkcl ,(compile-file-pathname i :fasl-p nil) ;; object file
#+sbcl ,@(let ((s (component-system c)))
(unless (builtin-system-p s) ; includes ASDF itself (unless (builtin-system-p s) ; includes ASDF itself
`(,(make-pathname :type "sbcl-warnings" :defaults f))))))) `(,(make-pathname :type (warnings-file-type) :defaults f))))
#+ecl
,@(unless (use-ecl-byte-compiler-p)
`(,(compile-file-pathname i :type :object)))
#+mkcl
,(compile-file-pathname i :fasl-p nil)))) ;; object file
(defmethod component-depends-on ((o compile-op) (c component)) (defmethod component-depends-on ((o compile-op) (c component))
(declare (ignorable o)) (declare (ignorable o))
`((prepare-op ,c) ,@(call-next-method))) `((prepare-op ,c) ,@(call-next-method)))
...@@ -133,7 +136,7 @@ ...@@ -133,7 +136,7 @@
(declare (ignorable o c)) (declare (ignorable o c))
nil nil
#+sbcl (perform-lisp-warnings-check o c)) #+sbcl (perform-lisp-warnings-check o c))
#+sbcl #+(or clozure sbcl)
(defmethod input-files ((o compile-op) (c system)) (defmethod input-files ((o compile-op) (c system))
(declare (ignorable o c)) (declare (ignorable o c))
(unless (builtin-system-p c) (unless (builtin-system-p c)
......
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
#:reify-simple-sexp #:unreify-simple-sexp #:reify-simple-sexp #:unreify-simple-sexp
#:reify-deferred-warnings #:reify-undefined-warning #:unreify-deferred-warnings #:reify-deferred-warnings #:reify-undefined-warning #:unreify-deferred-warnings
#:reset-deferred-warnings #:save-deferred-warnings #:check-deferred-warnings #:reset-deferred-warnings #:save-deferred-warnings #:check-deferred-warnings
#:with-saved-deferred-warnings #:warnings-file-p #:with-saved-deferred-warnings #:warnings-file-p #:warnings-file-type
#:call-with-asdf-compilation-unit #:with-asdf-compilation-unit #:call-with-asdf-compilation-unit #:with-asdf-compilation-unit
#:current-lisp-file-pathname #:load-pathname #:current-lisp-file-pathname #:load-pathname
#:lispize-pathname #:compile-file-type #:call-around-hook #:lispize-pathname #:compile-file-type #:call-around-hook
...@@ -193,11 +193,41 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -193,11 +193,41 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(cons (cons (unreify-simple-sexp (car sexp)) (unreify-simple-sexp (cdr sexp)))) (cons (cons (unreify-simple-sexp (car sexp)) (unreify-simple-sexp (cdr sexp))))
((simple-vector 2) (unreify-symbol sexp)))) ((simple-vector 2) (unreify-symbol sexp))))
#+clozure
(progn
(defun reify-source-note (source-note)
(when source-note
(with-accessors ((source ccl::source-note-source) (filename ccl:source-note-filename)
(start-pos ccl:source-note-start-pos) (end-pos ccl:source-note-end-pos)) source-note
(declare (ignorable source))
(list :filename filename :start-pos start-pos :end-pos end-pos
#|:source (reify-source-note source)|#))))
(defun unreify-source-note (source-note)
(when source-note
(destructuring-bind (&key filename start-pos end-pos source) source-note
(ccl::make-source-note :filename filename :start-pos start-pos :end-pos end-pos
:source (unreify-source-note source)))))
(defun reify-deferred-warning (deferred-warning)
(with-accessors ((warning-type ccl::compiler-warning-warning-type)
(args ccl::compiler-warning-args)
(source-note ccl:compiler-warning-source-note)
(function-name ccl:compiler-warning-function-name)) deferred-warning
(list :warning-type warning-type :function-name (reify-simple-sexp function-name)
:source (reify-source-note source-note) :args (reify-simple-sexp args))))
(defun unreify-deferred-warning (reified-deferred-warning)
(destructuring-bind (&key warning-type function-name source-note args)
reified-deferred-warning
(make-condition (or (cdr (ccl::assq warning-type ccl::*compiler-whining-conditions*))
'ccl::compiler-warning)
:function-name (unreify-simple-sexp function-name)
:source-note (unreify-source-note source-note)
:warning-type warning-type
:args (unreify-simple-sexp args)))))
#+sbcl
(defun reify-undefined-warning (warning) (defun reify-undefined-warning (warning)
;; Extracting undefined-warnings from the compilation-unit ;; Extracting undefined-warnings from the compilation-unit
;; To be passed through the above reify/unreify link, it must be a "simple-sexp" ;; To be passed through the above reify/unreify link, it must be a "simple-sexp"
#-sbcl (declare (ignore warning))
#+sbcl
(list* (list*
(sb-c::undefined-warning-kind warning) (sb-c::undefined-warning-kind warning)
(sb-c::undefined-warning-name warning) (sb-c::undefined-warning-name warning)
...@@ -215,7 +245,10 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -215,7 +245,10 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(sb-c::undefined-warning-warnings warning)))) (sb-c::undefined-warning-warnings warning))))
(defun reify-deferred-warnings () (defun reify-deferred-warnings ()
#-sbcl nil #+clozure
(mapcar 'reify-deferred-warning
(if-let (dw ccl::*outstanding-deferred-warnings*)
(ccl::deferred-warnings.warnings dw)))
#+sbcl #+sbcl
(when sb-c::*in-compilation-unit* (when sb-c::*in-compilation-unit*
;; Try to send nothing through the pipe if nothing needs to be accumulated ;; Try to send nothing through the pipe if nothing needs to be accumulated
...@@ -231,10 +264,15 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -231,10 +264,15 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
:when (plusp value) :when (plusp value)
:collect `(,what . ,value))))) :collect `(,what . ,value)))))
(defun unreify-deferred-warnings (constructor-list) (defun unreify-deferred-warnings (reified-deferred-warnings)
#-sbcl (declare (ignore constructor-list)) (declare (ignorable reified-deferred-warnings))
#+clozure
(let ((dw (or ccl::*outstanding-deferred-warnings*
(setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t)))))
(setf (ccl::deferred-warnings.warnings dw)
(mapcar 'unreify-deferred-warning reified-deferred-warnings)))
#+sbcl #+sbcl
(dolist (item constructor-list) (dolist (item reified-deferred-warnings)
;; Each item is (symbol . adjustment) where the adjustment depends on the symbol. ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
;; For *undefined-warnings*, the adjustment is a list of initargs. ;; For *undefined-warnings*, the adjustment is a list of initargs.
;; For everything else, it's an integer. ;; For everything else, it's an integer.
...@@ -261,6 +299,9 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -261,6 +299,9 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(set symbol (+ (symbol-value symbol) adjustment))))))) (set symbol (+ (symbol-value symbol) adjustment)))))))
(defun reset-deferred-warnings () (defun reset-deferred-warnings ()
#+clozure
(if-let ((dw ccl::*outstanding-deferred-warnings*))
(setf (ccl::deferred-warnings.warnings dw) nil))
#+sbcl #+sbcl
(when sb-c::*in-compilation-unit* (when sb-c::*in-compilation-unit*
(setf sb-c::*undefined-warnings* nil (setf sb-c::*undefined-warnings* nil
...@@ -279,8 +320,14 @@ possibly in a different process." ...@@ -279,8 +320,14 @@ possibly in a different process."
(terpri s))) (terpri s)))
(reset-deferred-warnings)) (reset-deferred-warnings))
(defun* warnings-file-p (file) (defun* warnings-file-type (&optional implementation-type)
(equal (pathname-type file) "sbcl-warnings")) (case (or implementation-type *implementation-type*)
(:sbcl "sbcl-warnings")
((:clozure :ccl) "ccl-warnings")))
(defun* warnings-file-p (file &optional implementation-type)
(if-let (type (warnings-file-type implementation-type))
(equal (pathname-type file) type)))
(defun* check-deferred-warnings (files &optional context-format context-arguments) (defun* check-deferred-warnings (files &optional context-format context-arguments)
(let ((file-errors nil) (let ((file-errors nil)
...@@ -306,6 +353,26 @@ possibly in a different process." ...@@ -306,6 +353,26 @@ possibly in a different process."
;;;; Deferred warnings ;;;; Deferred warnings
#|
Mini-guide to adding support for deferred warnings on an implementation.
First, look at what such a warning looks like:
(describe
(handler-case
(and (eval '(lambda () (some-undefined-function))) nil)
(t (c) c)))
Then you can grep for the condition type in your compiler sources
and see how to catch those that have been deferred,
and/or read, clear and restore the deferred list.
ccl::
undefined-function-reference
verify-deferred-warning
report-deferred-warnings
|#
(defun* call-with-saved-deferred-warnings (thunk warnings-file) (defun* call-with-saved-deferred-warnings (thunk warnings-file)
(if warnings-file (if warnings-file
......
...@@ -12,7 +12,8 @@ ...@@ -12,7 +12,8 @@
#:getenv-pathname #:getenv-pathnames #:getenv-pathname #:getenv-pathnames
#:getenv-absolute-directory #:getenv-absolute-directories #:getenv-absolute-directory #:getenv-absolute-directories
#:implementation-identifier ;; implementation identifier #:implementation-identifier ;; implementation identifier
#:implementation-type #:operating-system #:architecture #:lisp-version-string #:implementation-type #:*implementation-type*
#:operating-system #:architecture #:lisp-version-string
#:hostname #:user-homedir #:lisp-implementation-directory #:hostname #:user-homedir #:lisp-implementation-directory
#:getcwd #:chdir #:call-with-current-directory #:with-current-directory #:getcwd #:chdir #:call-with-current-directory #:with-current-directory
#:*temporary-directory* #:temporary-directory #:default-temporary-directory #:*temporary-directory* #:temporary-directory #:default-temporary-directory
...@@ -161,6 +162,8 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" ...@@ -161,6 +162,8 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
(:lwpe :lispworks-personal-edition) (:lw :lispworks) (:lwpe :lispworks-personal-edition) (:lw :lispworks)
:mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl))) :mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
(defvar *implementation-type* (implementation-type))
(defun* operating-system () (defun* operating-system ()
(first-feature (first-feature
'(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first! '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first!
......
...@@ -196,6 +196,8 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -196,6 +196,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
(latest-stamp-f stamp (funcall dependency-stamper dep-o dep-c))))) (latest-stamp-f stamp (funcall dependency-stamper dep-o dep-c)))))
stamp) stamp)
(asdf-debug)
(defmethod compute-action-stamp (plan (o operation) (c component) &key just-done) (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)
;; In a distant future, safe-file-write-date and component-operation-time ;; In a distant future, safe-file-write-date and component-operation-time
;; shall also be parametrized by the plan, or by a second model object. ;; shall also be parametrized by the plan, or by a second model object.
...@@ -246,7 +248,6 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -246,7 +248,6 @@ the action of OPERATION on COMPONENT in the PLAN"))
;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet ;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet
(values t nil)))) (values t nil))))
;;;; Generic support for plan-traversal ;;;; Generic support for plan-traversal
(defgeneric* plan-record-dependency (plan operation component)) (defgeneric* plan-record-dependency (plan operation component))
......
...@@ -23,6 +23,7 @@ Some constraints: ...@@ -23,6 +23,7 @@ Some constraints:
#:assert-compare #:assert-compare
#:assert-equal #:assert-equal
#:leave-test #:def-test-system #:leave-test #:def-test-system
#:action-name #:in-plan-p
#:test-source #:test-fasl #:resolve-output #:output-location #:test-source #:test-fasl #:resolve-output #:output-location
#:quietly)) #:quietly))
...@@ -438,6 +439,9 @@ is bound, write a message and exit on an error. If ...@@ -438,6 +439,9 @@ is bound, write a message and exit on an error. If
`(apply (asym :register-system-definition) ',name :pathname ,*test-directory* `(apply (asym :register-system-definition) ',name :pathname ,*test-directory*
:source-file nil ',rest)) :source-file nil ',rest))
(defun in-plan-p (plan x) (member x plan :key (asym :action-path) :test 'equal))
;; These are shorthands for interactive debugging of test scripts: ;; These are shorthands for interactive debugging of test scripts:
(!a (!a
common-lisp-user::debug-asdf debug-asdf common-lisp-user::debug-asdf debug-asdf
...@@ -451,4 +455,7 @@ is bound, write a message and exit on an error. If ...@@ -451,4 +455,7 @@ is bound, write a message and exit on an error. If
It depends on the DBG macro in contrib/debug.lisp, 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. 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))|# (let ((action-path (action-path (cons o c)))) (DBG :cas action-path 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)
;;; blah
))
|#
...@@ -2,46 +2,57 @@ ...@@ -2,46 +2,57 @@
(load-asdf) (load-asdf)
(touch-file "test1.asd" :offset -3600) ;; touch test1.asd an hour ago. (touch-file (test-source "test1.asd") :offset -3600) ;; touch test1.asd an hour ago.
(touch-file "file1.lisp" :offset -3500) (defparameter *date* (file-write-date (test-source "test1.asd")))
(touch-file "file2.lisp" :offset -3400)
(touch-file (test-source "file1.lisp") :timestamp (+ *date* 100))
(touch-file (test-source "file2.lisp") :timestamp (+ *date* 200))
(assert-equal (file-write-date (test-source "file1.lisp")) (+ *date* 100))
(assert-equal (file-write-date (test-source "file2.lisp")) (+ *date* 200))
(DBG "loading test1") (DBG "loading test1")
(asdf:load-system 'test1) (load-system 'test1)
(defparameter *file1* (test-fasl "file1")) (defparameter *file1.out* (output-files 'compile-op '(test1 "file1")))
(defparameter *file2* (test-fasl "file2")) (defparameter *file2.out* (output-files 'compile-op '(test1 "file2")))
(defparameter *date* (file-write-date "test1.asd")) (assert-equal (first *file1.out*) (test-fasl "file1"))
(defparameter *then* (file-write-date *file2*)) (assert-equal (first *file2.out*) (test-fasl "file2"))
(assert-equal *file1* (first (output-files 'compile-op '("test1" "file1")))) (assert-equal *date* (file-write-date (test-source "test1.asd")))
(defparameter *then* (file-write-date (first *file2.out*)))
(assert-compare (< *date* *then*))
(DBG "test that it compiled" *date* *then*) (DBG "test that it compiled" *date* *then*)
(assert (probe-file *file1*)) (dolist (f (append *file1.out* *file2.out*))
(assert (probe-file *file2*)) (eval `(assert (probe-file ,f))))
(DBG "and loaded") (DBG "and loaded")
(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package))) (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
(DBG "now remove file2 that depends-on file1" *date*) (DBG "now remove file2 that depends-on file1")
(touch-file *file1* :timestamp (+ *date* 500)) (dolist (f *file1.out*) (touch-file f :timestamp (+ *date* 500)))
(assert-equal (+ *date* 500) (file-write-date *file1*)) (assert-equal (+ *date* 500) (file-write-date (first *file1.out*)))
(asdf::delete-file-if-exists *file2*) (map () 'delete-file-if-exists *file2.out*)
(clear-system 'test1)
(DBG "load again") (DBG "load again")
(asdf:clear-system 'test1) ;;(trace input-files asdf::compute-action-stamp)
(asdf:load-system 'test1) (defparameter *plan* (nth-value 1 (operate 'load-op 'test1)))
(DBG "check that file1 is _not_ recompiled, but file2 is" (file-write-date *file1*)) (DBG "check that file1 is _not_ recompiled, but file2 is")
(assert-equal (+ *date* 500) (file-write-date *file1*)) (assert (in-plan-p *plan* '(compile-op "test1" "file2")))
(assert-compare (<= *then* (file-write-date *file2*))) (assert (not (in-plan-p *plan* '(compile-op "test1" "file1"))))
(assert-equal (+ *date* 500) (file-write-date (first *file1.out*)))
(assert-compare (<= *then* (file-write-date (first *file2.out*))))
(DBG "now touch file1 and check that file2 _is_ also recompiled") (DBG "now touch file1 and check that file2 _is_ also recompiled")
;; XXX run-shell-command loses if *default-pathname-defaults* is not the ;; XXX run-shell-command loses if *default-pathname-defaults* is not the
;; unix cwd. this is not a problem for run-tests.sh, but can be in general ;; unix cwd. this is not a problem for run-tests.sh, but can be in general
(defparameter *before* (file-write-date *file2*)) (defparameter *before* (file-write-date (first *file2.out*)))
(touch-file "file1.lisp" :timestamp (+ *date* 3000)) ;; touch file1 a minute ago. (touch-file (test-source "file1.lisp") :timestamp (+ *date* 3000)) ;; touch file1 a minute ago.
(touch-file *file2* :timestamp (+ *date* 2000)) ;; touch file2.fasl some time before. (dolist (f *file2.out*) (touch-file f :timestamp (+ *date* 2000))) ;; touch file2.fasl some time before.
(asdf:clear-system 'test1) (asdf:clear-system 'test1)
(asdf:operate 'asdf:load-op 'test1) (asdf:operate 'asdf:load-op 'test1)
(DBG :foo (file-write-date *file2*) *before*) (DBG :foo (file-write-date (first *file2.out*)) *before*)
(assert-compare (>= (file-write-date *file2*) *before*)) (assert-compare (>= (file-write-date (first *file2.out*)) *before*))
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.128") (asdf-version "2.26.129")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)) (already-there (equal asdf-version existing-version))
...@@ -46,7 +46,7 @@ ...@@ -46,7 +46,7 @@
#:perform-with-restarts #:component-relative-pathname #:perform-with-restarts #:component-relative-pathname
#:system-source-file #:operate #:find-component #:find-system #:system-source-file #:operate #:find-component #:find-system
#:apply-output-translations #:component-self-dependencies #:apply-output-translations #:component-self-dependencies
#:system-relative-pathname #:system-relative-pathname #:resolve-location
#:inherit-source-registry #:process-source-registry #:inherit-source-registry #:process-source-registry
#:process-source-registry-directive #:source-file-type #:process-source-registry-directive #:source-file-type
#:process-output-translations-directive #:process-output-translations-directive
......
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