Commit decc2a2c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.168: translate-logical-pathname in probe-file*.

Had to refactor the asdf-pathname-test by decomposing it into small bits
before I could understand what was going on.
Some more robustness in find-system.

Also, no build-report output-file when no *warnings-file-type*,
and ABL support for build-report.

Deprecate *asdf-verbose*.
Have *verbose-out* be NIL (which is testable) rather than
(make-broadcast-stream), which isn't quite, to signal no verbosity.
That's both more useful while remaining backward-compatible.
parent 1722af58
......@@ -272,7 +272,7 @@ in some previous image, or T if it needs to be done.")
(defmethod perform-with-restarts (operation component)
;; TOO verbose, especially as the default. Add your own :before method
;; to perform-with-restart or perform if you want that:
#|(when *asdf-verbose* (explain operation component))|#
#|(explain operation component)|#
(perform operation component))
(defmethod perform-with-restarts :around (operation component)
(loop
......
......@@ -66,7 +66,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.167" ;; to be automatically updated by make bump-version
:version "2.26.168" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
......
......@@ -74,11 +74,12 @@ if that's whay you mean." ;;)
(include-per-user-information nil)
(map-all-source-files (or #+(or clisp ecl mkcl) t nil))
(source-to-target-mappings nil)
(file-types (list (compile-file-type)
#+ecl (compile-file-type :type :object)
#+mkcl (compile-file-type :fasl-p nil)
#+clisp "lib" #+sbcl "cfasl"
#+sbcl "sbcl-warnings" #+clozure "ccl-warnings")))
(file-types `(,(compile-file-type)
"build-report"
#+ecl (compile-file-type :type :object)
#+mkcl (compile-file-type :fasl-p nil)
#+clisp "lib" #+sbcl "cfasl"
#+sbcl "sbcl-warnings" #+clozure "ccl-warnings")))
#+(or clisp ecl mkcl)
(when (null map-all-source-files)
(error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on CLISP, ECL and MKCL"))
......@@ -133,3 +134,4 @@ Please use ASDF-DRIVER:RUN-PROGRAM instead."
(asdf-message "; $ ~A~%" command)
(run-program command :force-shell t :ignore-error-status t :output *verbose-out*)))
(defvar *asdf-verbose* nil) ;; backward-compatibility with ASDF2 only. Unused.
......@@ -92,11 +92,11 @@ or the original (parsed) pathname if it is false (the default)."
(if truename
(probe-file p)
(and (ignore-errors
#+(or cmu scl) (unix:unix-stat (ext:unix-namestring (translate-logical-pathname p)))
#+(and lispworks unix) (system:get-file-stat p)
#+sbcl (sb-unix:unix-stat (sb-ext:native-namestring (translate-logical-pathname p)))
#-(or cmu (and lispworks unix) sbcl scl)
(file-write-date p))
(let ((pp (translate-logical-pathname p)))
#+(or cmu scl) (unix:unix-stat (ext:unix-namestring pp))
#+(and lispworks unix) (system:get-file-stat pp)
#+sbcl (sb-unix:unix-stat (sb-ext:native-namestring pp))
#-(or cmu (and lispworks unix) sbcl scl) (file-write-date pp)))
p))
#+(or clisp gcl2.6)
#.(flet ((probe (probe)
......
......@@ -306,13 +306,15 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(when (and system pathname)
(setf (system-source-file system) pathname))
(when (and pathname
(not (and previous
(or (pathname-equal pathname previous-pathname)
(and pathname previous-pathname
(pathname-equal
(translate-logical-pathname pathname)
(translate-logical-pathname previous-pathname))))
(stamp<= (get-file-stamp pathname) previous-time))))
(let ((stamp (get-file-stamp pathname)))
(and stamp
(not (and previous
(or (pathname-equal pathname previous-pathname)
(and pathname previous-pathname
(pathname-equal
(translate-logical-pathname pathname)
(translate-logical-pathname previous-pathname))))
(stamp<= stamp previous-time))))))
;; only load when it's a pathname that is different or has newer content
(load-asd pathname :name name)))
(let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.167: Another System Definition Facility.
;;; This is ASDF 2.26.168: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -87,7 +87,7 @@
#:*compile-file-failure-behaviour*
#:*resolve-symlinks*
#:*load-system-operation*
#:*asdf-verbose*
#:*asdf-verbose* ;; unused. For backward-compatibility only.
#:*verbose-out*
#:asdf-version
......
......@@ -154,7 +154,7 @@
:nconc (remove-if-not 'warnings-file-p (output-files o sub))))))
#+sbcl
(defmethod output-files ((o compile-op) (c system))
(unless (builtin-system-p c)
(when (and *warnings-file-type* (not (builtin-system-p c)))
(if-let ((pathname (component-pathname c)))
(list (subpathname pathname (component-name c) :type "build-report")))))
......
......@@ -32,8 +32,7 @@
(declare (ignorable operation component))
;; Setup proper bindings around any operate call.
(with-system-definitions ()
(let* ((*asdf-verbose* verbose)
(*verbose-out* (if verbose *standard-output* (make-broadcast-stream)))
(let* ((*verbose-out* (and verbose *standard-output*))
(*compile-file-warnings-behaviour* on-warnings)
(*compile-file-failure-behaviour* on-failure))
(call-next-method))))
......
......@@ -274,7 +274,7 @@ system names to pathnames of .asd files")
((gethash name registry) ; already shadowed by something else
nil)
((gethash name h) ; conflict at current level
(when *asdf-verbose*
(when *verbose-out*
(warn (compatfmt "~@<In source-registry entry ~A~@[/~*~] ~
found several entries for ~A - picking ~S over ~S~:>")
directory recurse name (gethash name h) asd)))
......
This diff is collapsed.
......@@ -14,7 +14,9 @@ Some constraints:
(:use :common-lisp)
(:export
#:asym #:acall #:asymval
#:*test-directory* #:*asdf-directory*
#:*test-directory* #:*asdf-directory* #:*build-directory* #:*implementation*
#:assert-compare #:assert-pathname-equal #:assert-pathnames-equal
#:hash-table->alist
#:load-asdf #:maybe-compile-asdf
#:load-asdf-lisp #:compile-asdf #:load-asdf-fasl
#:compile-load-asdf #:load-asdf-system #:clean-load-asdf-system
......
......@@ -7,7 +7,7 @@
(:use :asdf/common-lisp :asdf/driver)
(:export
#:asdf-version #:*previous-asdf-versions* #:*asdf-version*
#:asdf-message #:*asdf-verbose* #:*verbose-out*
#:asdf-message #:*verbose-out*
#:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error
#:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
;; There will be no symbol left behind!
......@@ -30,10 +30,9 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
(null "1.0"))))))
(defvar *asdf-version* nil)
(defvar *previous-asdf-versions* nil)
(defvar *asdf-verbose* nil) ; was t from 2.000 to 2.014.12.
(defvar *verbose-out* nil)
(defun* asdf-message (format-string &rest format-args)
(apply 'format *verbose-out* format-string format-args))
(when *verbose-out* (apply 'format *verbose-out* format-string format-args)))
(defvar *post-upgrade-cleanup-hook* ())
(defvar *post-upgrade-restart-hook* ())
(defun* upgrading-p ()
......@@ -52,12 +51,12 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "2.26.167")
(asdf-version "2.26.168")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
(push existing-version *previous-asdf-versions*)
(when *asdf-verbose*
(when (or *load-verbose* *verbose-out*)
(format *trace-output*
(compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%")
existing-version asdf-version)))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment