From eef7278fae80a999219cd40d39a66d69af94539a Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Mon, 14 Jan 2013 11:26:20 -0500 Subject: [PATCH] 2.26.94: Yet another package cleanup. Debug the test scripts. Package cleanup: every file in asdf itself now :use's asdf/driver asdf/upgrade. Test script fix: Allegro, like ECL *really* hates that we close *standard-input*, so stop trying at all. Tweak some utilities and debug utilities. --- action.lisp | 4 ++-- asdf.asd | 2 +- backward-interface.lisp | 4 ++-- backward-internals.lisp | 4 ++-- bin/bump-version | 20 +++++++++++++----- bundle.lisp | 4 ++-- component.lisp | 2 +- concatenate-source.lisp | 8 +++---- contrib/debug.lisp | 45 ++++++++++++++++++++-------------------- defsystem.lisp | 4 ++-- find-component.lisp | 3 +-- find-system.lisp | 3 +-- footer.lisp | 6 ++---- header.lisp | 2 +- image.lisp | 2 +- interface.lisp | 11 ++++------ lisp-action.lisp | 4 ++-- operate.lisp | 7 +++---- operation.lisp | 2 +- output-translations.lisp | 2 +- pathname.lisp | 2 +- source-registry.lisp | 3 +-- system.lisp | 3 +-- test/script-support.lisp | 36 +++++++++++++++++++++----------- test/test1.script | 7 ++++--- upgrade.lisp | 2 +- utility.lisp | 40 ++++++++++++++++------------------- version.lisp-expr | 2 +- 28 files changed, 122 insertions(+), 112 deletions(-) diff --git a/action.lisp b/action.lisp index 61eeb7760..9fb908c34 100644 --- a/action.lisp +++ b/action.lisp @@ -3,8 +3,8 @@ (asdf/package:define-package :asdf/action (:recycle :asdf/action :asdf) - (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build - :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation) + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation) #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of) (:intern #:stamp #:done-p) (:export diff --git a/asdf.asd b/asdf.asd index 2a0e709d9..46b77b176 100644 --- a/asdf.asd +++ b/asdf.asd @@ -15,7 +15,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.93" ;; to be automatically updated by bin/bump-revision + :version "2.26.94" ;; 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 generate-asdf)))) diff --git a/backward-interface.lisp b/backward-interface.lisp index 8cf828e92..f77e566c6 100644 --- a/backward-interface.lisp +++ b/backward-interface.lisp @@ -3,8 +3,8 @@ (asdf/package:define-package :asdf/backward-interface (:recycle :asdf/backward-interface :asdf) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/run-program - :asdf/upgrade :asdf/component :asdf/system :asdf/operation :asdf/action + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-build :asdf/operate :asdf/output-translations) (:export #:*asdf-verbose* diff --git a/backward-internals.lisp b/backward-internals.lisp index a46c541e6..0d4b3d885 100644 --- a/backward-internals.lisp +++ b/backward-internals.lisp @@ -3,8 +3,8 @@ (asdf/package:define-package :asdf/backward-internals (:recycle :asdf/backward-internals :asdf) - (:use :common-lisp :asdf/utility :asdf/pathname - :asdf/upgrade :asdf/system :asdf/component :asdf/find-system :asdf/action) + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/system :asdf/component :asdf/find-system :asdf/action) (:export ;; for internal use #:%refresh-component-inline-methods #:%resolve-if-component-dep-fails)) diff --git a/bin/bump-version b/bin/bump-version index c070e234c..03ac3ca5a 100755 --- a/bin/bump-version +++ b/bin/bump-version @@ -2,17 +2,26 @@ ":" ; exec sbcl --script "$0" "$@" ; exit # -*- Lisp -*- ;;; Really runs on any decent Common Lisp implementation +(setf *load-verbose* nil *load-print* nil + *compile-verbose* nil *compile-print* nil) + +(format t "Loading ASDF... ~%") (require :asdf) (in-package :asdf) - +#-asdf2 (error "Not ASDF2, you lose!") +(format t "Initializing the source registry... ~%") +(initialize-source-registry) +(format t "Making sure that's the latest... ~%") (upgrade-asdf) - +(format t "Now load some dependencies... ~%") (load-systems :cl-ppcre :xcvb-utils) (in-package :xcvb-utils) +(format t "And the debug utilities... ~%") (asdf-debug) +(DBG "There we are!") (resume-image) (defun afile (x) @@ -50,17 +59,19 @@ &key (reader 'read-file-string) (writer nil) (comparator 'equalp) (external-format *utf-8-external-format*)) + (format t "Transforming file ~A... " (file-namestring file)) (let* ((old-contents (funcall reader file)) (new-contents (funcall transformer old-contents))) (if (funcall comparator old-contents new-contents) - (format t "No changes for file ~A~%" file) + (format t "no changes needed!~%") (let ((written-contents (if writer (with-output (s ()) (funcall writer s new-contents)) new-contents))) (check-type written-contents (or string (byte-vector))) - (clobber-file-with-vector file written-contents :external-format external-format))))) + (clobber-file-with-vector file written-contents :external-format external-format) + (format t "done.~%"))))) (defun version-transform (text) (flet ((v1 (ver) (format nil "~S" ver)) @@ -74,7 +85,6 @@ '("version.lisp-expr" "asdf.asd" "header.lisp" "build/asdf.lisp" "upgrade.lisp")) (defun transform-file (x) - (format t "Transforming file ~A~%" x) (maybe-replace-file (afile x) #'version-transform)) (map () 'transform-file *versioned-files*) diff --git a/bundle.lisp b/bundle.lisp index 8e05a1c3c..93e3f0c66 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -3,8 +3,7 @@ (asdf/package:define-package :asdf/bundle (:recycle :asdf/bundle :asdf) - (:intern #:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build :asdf/upgrade + (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate) (:export @@ -19,6 +18,7 @@ #+ecl #:make-build #+mkcl #:mkcl-bundle-sub-operations #+mkcl #:files-to-bundle #+mkcl #:bundle-system #+(or ecl mkcl) #:register-pre-built-system + #:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library #:system-fasl)) (in-package :asdf/bundle) diff --git a/component.lisp b/component.lisp index 2dbc5b56d..3648e9a56 100644 --- a/component.lisp +++ b/component.lisp @@ -3,7 +3,7 @@ (asdf/package:define-package :asdf/component (:recycle :asdf/component :asdf) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/upgrade) + (:use :common-lisp :asdf/driver :asdf/upgrade) (:export #:component #:component-find-path #:component-name #:component-pathname #:component-relative-pathname diff --git a/concatenate-source.lisp b/concatenate-source.lisp index fa784368d..b150d5efb 100644 --- a/concatenate-source.lisp +++ b/concatenate-source.lisp @@ -3,9 +3,8 @@ (asdf/package:define-package :asdf/concatenate-source (:recycle :asdf/concatenate-source :asdf) - (:intern #:translate-output-p #:concatenated-source-file) - (:use :common-lisp :asdf/utility :asdf/stream - :asdf/upgrade :asdf/component :asdf/operation + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/operation :asdf/system :asdf/find-system :asdf/defsystem :asdf/action :asdf/lisp-action :asdf/bundle) (:export @@ -19,7 +18,8 @@ #:monolithic-load-compiled-concatenated-source-op #:concatenated-source-system #:system-concatenated-source-file - #:system-translate-output-p)) + #:system-translate-output-p + #:translate-output-p #:concatenated-source-file)) (in-package :asdf/concatenate-source) ;;; diff --git a/contrib/debug.lisp b/contrib/debug.lisp index d9cc5ba9c..e3d05d533 100644 --- a/contrib/debug.lisp +++ b/contrib/debug.lisp @@ -1,18 +1,18 @@ ;;;;; A few essential debugging utilities by Faré, -;;;;; to be loaded in the *PACKAGE* in which you wish to debug. - -;; We want debugging utilities in the current package, -;; so we don't have to cheat with packages, -;; or have symbols that clash when trying use-package or import. +;;;;; to be loaded in the *PACKAGE* that you wish to debug. ;; -;; The short names of symbols below are unlikely to have defined bindings -;; in a well-designed source file to be debugged, -;; but are quite practical in a debugging session. +;; We want debugging utilities in the _current_ package, +;; so we don't have to either change the package structure +;; or use heavy package prefixes everywhere. ;; - - +;; The short names of symbols below are unlikely to clash +;; with global bindings of any well-designed source file being debugged, +;; yet are quite practical in a debugging session. #| -;;; If ASDF is already loaded, you can load these utilities as follows: +;;; If ASDF is already loaded, +;;; you can load these utilities in the current package as follows: +(d:asdf-debug) +;; which if you left the :D nickname to asdf/driver is short for: (asdf/utility::asdf-debug) ;; The above macro can be configured to load any other debugging utility @@ -24,7 +24,7 @@ ;; on different machines, with your debug file in ~/lisp/debug-utils.lisp ;; you could in your ~/.sbclrc have the following configuration setting: (require :asdf) -(setf asdf-utility:*asdf-debug-utility* +(setf asdf/utility:*asdf-debug-utility* '(asdf/pathname:subpathname (asdf/os:user-homedir) "lisp/debug-utils.lisp")) ;;; If ASDF is not loaded (for instance, when debugging ASDF itself), @@ -32,8 +32,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (let ((kw (read-from-string (format nil ":DBG-~A" (package-name *package*))))) (unless (member kw *features*) - (load "/home/tunes/cl/asdf/contrib/debug.lisp") - ))) + (load "/home/tunes/cl/asdf/contrib/debug.lisp")))) |# @@ -54,10 +53,12 @@ TAG is typically a constant string or keyword, but in general is an expression returning a tag to be printed first; if the expression returns NIL, nothing is printed. -EXPRS are expression, the source then the value of which is printed; -The values of the last expression are returned. -Aim for relatively low overhead in space of time. -Other expressions are not evaluated if TAG returned NIL." +EXPRS are expressions, which when the TAG was not NIL are evaluated in order, +with their source code then their return values being printed each time. +The last expresion is *always* evaluated and its values are returned, +but its source and return values are only printed if TAG was not NIL; +previous expressions are not evaluated at all if TAG returned NIL. +The macro expansion has relatively low overhead in space of time." (let* ((last-expr (car (last exprs))) (other-exprs (butlast exprs)) (tag-var (gensym "TAG")) @@ -99,10 +100,10 @@ Other expressions are not evaluated if TAG returned NIL." ;;; Quick definitions for use at the REPL -(defun w (x) (format t "~&~S~%" x)) ; Write -(defun a (&optional x) (format t "~&~@[~A~]~%" x)) ; print Anything -(defun e (x) (cons x (ignore-errors (list (eval x))))) ; eValuate -(defmacro x (x) `(format t "~&~S => ~S~%" ',x ,x)) ; eXamine +(defun w (&rest x) (format t "~&~{~S~^ ~}~%" x)) ;Write, space separated + LF +(defun a (&rest x) (format t "~&~{~A~}~%" x)) ;print Anything, no separator, LF +(defun e (x) (cons x (ignore-errors (list (eval x))))) ;eValuate +(defmacro x (x) `(format t "~&~S => ~S~%" ',x ,x)) ;eXamine (defmacro !a (&rest foo) ; define! Alias `(progn ,@(loop :for (alias name) :on foo :by #'cddr :collect (if (macro-function name) diff --git a/defsystem.lisp b/defsystem.lisp index d1a2f2f22..555e09ef0 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -3,8 +3,8 @@ (asdf/package:define-package :asdf/defsystem (:recycle :asdf/defsystem :asdf) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream - :asdf/upgrade :asdf/component :asdf/system + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate :asdf/backward-internals) #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of) diff --git a/find-component.lisp b/find-component.lisp index 1d0a74101..085f7a79d 100644 --- a/find-component.lisp +++ b/find-component.lisp @@ -3,8 +3,7 @@ (asdf/package:define-package :asdf/find-component (:recycle :asdf/find-component :asdf) - (:use :common-lisp :asdf/utility :asdf/os - :asdf/upgrade :asdf/component :asdf/system :asdf/find-system) + (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component :asdf/system :asdf/find-system) (:export #:find-component #:resolve-dependency-name #:resolve-dependency-spec diff --git a/find-system.lisp b/find-system.lisp index b31875169..80e225eb7 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -3,8 +3,7 @@ (asdf/package:define-package :asdf/find-system (:recycle :asdf/find-system :asdf) - (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream :asdf/os - :asdf/lisp-build :asdf/upgrade :asdf/component :asdf/system) + (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component :asdf/system) (:export #:remove-entry-from-registry #:coerce-entry-to-directory #:coerce-name #:find-system #:locate-system #:load-sysdef #:with-system-definitions diff --git a/footer.lisp b/footer.lisp index 08028cb70..68b116286 100644 --- a/footer.lisp +++ b/footer.lisp @@ -3,12 +3,10 @@ (asdf/package:define-package :asdf/footer (:recycle :asdf/footer :asdf) - (:use :common-lisp - :asdf/package :asdf/compatibility - :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build + (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/operate :asdf/bundle :asdf/concatenate-source - :asdf/configuration :asdf/output-translations :asdf/source-registry + :asdf/output-translations :asdf/source-registry :asdf/backward-internals :asdf/defsystem :asdf/backward-interface :asdf/interface)) (in-package :asdf/footer) diff --git a/header.lisp b/header.lisp index efc53eb15..239714bb3 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.93: Another System Definition Facility. +;;; This is ASDF 2.26.94: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/image.lisp b/image.lisp index 04ecebb10..0658c7bce 100644 --- a/image.lisp +++ b/image.lisp @@ -3,7 +3,7 @@ (asdf/package:define-package :asdf/image (:recycle :asdf/image :xcvb-driver) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os) + (:use :common-lisp :asdf/package :asdf/utility :asdf/pathname :asdf/stream :asdf/os) (:export #:*dumped* #:raw-command-line-arguments #:*command-line-arguments* #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments diff --git a/interface.lisp b/interface.lisp index 1a5e77e36..c4fc4dcaa 100644 --- a/interface.lisp +++ b/interface.lisp @@ -10,16 +10,13 @@ #:split #:make-collector #:loaded-systems ; makes for annoying SLIME completion #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function - (:use :common-lisp - :asdf/driver - :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/output-translations :asdf/source-registry :asdf/plan :asdf/operate :asdf/defsystem :asdf/bundle :asdf/concatenate-source - :asdf/backward-interface) - (:shadowing-import-from :asdf/package - :find-symbol* #:intern*) - ;; TODO: automatically generate interface by merging select used packages? + :asdf/backward-internals :asdf/backward-interface) + ;; TODO: automatically generate interface with reexport? (:export #:defsystem #:find-system #:locate-system #:coerce-name #:oos #:operate #:traverse #:perform-plan diff --git a/lisp-action.lisp b/lisp-action.lisp index 95835092a..7ae892b00 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -4,8 +4,8 @@ (asdf/package:define-package :asdf/lisp-action (:recycle :asdf/lisp-action :asdf) (:intern #:proclamations #:flags) - (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/lisp-build - :asdf/upgrade :asdf/component :asdf/system :asdf/find-component :asdf/operation :asdf/action) + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/system :asdf/find-component :asdf/operation :asdf/action) (:export #:compile-error #:compile-failed #:compile-warned #:try-recompiling #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp diff --git a/operate.lisp b/operate.lisp index b7e0bea3d..c8d8f0e21 100644 --- a/operate.lisp +++ b/operate.lisp @@ -3,10 +3,9 @@ (asdf/package:define-package :asdf/operate (:recycle :asdf/operate :asdf) - (:use :common-lisp :asdf/package :asdf/utility :asdf/upgrade - :asdf/component :asdf/system :asdf/operation :asdf/action - :asdf/lisp-build :asdf/lisp-action #:asdf/plan - :asdf/find-system :asdf/find-component) + (:use :common-lisp :asdf/driver :asdf/upgrade + :asdf/component :asdf/system :asdf/operation :asdf/action + :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan) (:export #:operate #:oos #:*systems-being-operated* #:*asdf-upgrade-already-attempted* #:load-system #:load-systems #:compile-system #:test-system #:require-system diff --git a/operation.lisp b/operation.lisp index 4db71eff6..4b604304b 100644 --- a/operation.lisp +++ b/operation.lisp @@ -3,7 +3,7 @@ (asdf/package:define-package :asdf/operation (:recycle :asdf/operation :asdf) - (:use :common-lisp :asdf/utility :asdf/upgrade) + (:use :common-lisp :asdf/driver :asdf/upgrade) (:export #:operation #:operation-original-initargs ;; backward-compatibility only. DO NOT USE. diff --git a/output-translations.lisp b/output-translations.lisp index fd0d60c09..7b0fc2a67 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -3,7 +3,7 @@ (asdf/package:define-package :asdf/output-translations (:recycle :asdf/output-translations :asdf) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build :asdf/upgrade :asdf/configuration) + (:use :common-lisp :asdf/driver :asdf/upgrade) (:export #:*output-translations* #:*output-translations-parameter* #:invalid-output-translation diff --git a/pathname.lisp b/pathname.lisp index 726d1dc5d..2f9dd9469 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -4,7 +4,7 @@ (asdf/package:define-package :asdf/pathname (:recycle :asdf/pathname :asdf) #+gcl<2.7 (:shadowing-import-from :system :*load-pathname*) ;; GCL 2.6 sucks - (:use :common-lisp :asdf/compatibility :asdf/utility) + (:use :common-lisp :asdf/package :asdf/compatibility :asdf/utility) (:export #:*resolve-symlinks* ;; Making and merging pathnames, portably diff --git a/source-registry.lisp b/source-registry.lisp index 47b08c54c..49bc9b1e5 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -4,8 +4,7 @@ (asdf/package:define-package :asdf/source-registry (:recycle :asdf/source-registry :asdf) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os - :asdf/upgrade :asdf/find-system :asdf/configuration) + (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/find-system) (:export #:*source-registry* #:*source-registry-parameter* #:*default-source-registries* #:invalid-source-registry diff --git a/system.lisp b/system.lisp index ef8b86a24..c483d1812 100644 --- a/system.lisp +++ b/system.lisp @@ -3,8 +3,7 @@ (asdf/package:define-package :asdf/system (:recycle :asdf :asdf/system) - (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade - :asdf/component) + (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component) (:intern #:children #:children-by-name #:default-component-class #:author #:maintainer #:licence #:source-file #:defsystem-depends-on) (:export diff --git a/test/script-support.lisp b/test/script-support.lisp index 5393fa8ec..82ff0a987 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -72,6 +72,7 @@ Some constraints: :do (finish-output s))) (defun redirect-outputs () (finish-outputs) + #-allegro (setf *error-output* *standard-output* *trace-output* *standard-output*)) @@ -130,6 +131,8 @@ Some constraints: ;;; Test helper functions +(load (debug-lisp)) + (defmacro assert-compare (expr) (destructuring-bind (op x y) expr `(assert-compare-helper ',op ',x ',y ,x ,y))) @@ -342,43 +345,52 @@ is bound, write a message and exit on an error. If (defmacro test-asdf (&body body) ;; used by test-upgrade `(testing-asdf #'(lambda () ,@body))) -(defun close-inputs () - #-ecl (close *standard-input*)) - (defun configure-asdf () - (untrace) + (DBG "Debugging?" *debug-asdf*) (setf *debug-asdf* (or *debug-asdf* (acall :getenvp "DEBUG_ASDF_TEST"))) - (unless *debug-asdf* (close-inputs)) + (DBG "Tracing?" *trace-symbols*) + (untrace) (eval `(trace ,@(loop :for s :in *trace-symbols* :collect (asym s)))) + (DBG "Initializing source registry") (acall :initialize-source-registry `(:source-registry :ignore-inherited-configuration)) + (DBG "Initializing output-translations") (acall :initialize-output-translations `(:output-translations ((,*asdf-directory* :**/ :*.*.*) (,*asdf-directory* "build/fasls" :implementation "asdf")) (t (,*asdf-directory* "build/fasls" :implementation "root")) :ignore-inherited-configuration)) (set (asym :*central-registry*) `(,*test-directory*)) + (DBG "Verbose output for ASDF") (set (asym :*verbose-out*) *standard-output*) (set (asym :*asdf-verbose*) t)) (defun load-asdf (&optional tag) - (setf *package* (find-package :asdf-test)) - (load (debug-lisp)) + (DBG "loading the ASDF fasl") (load-asdf-fasl tag) (use-package :asdf :asdf-test) + (DBG "configuring ASDF") (configure-asdf) + (DBG "reading for your script") (setf *package* (find-package :asdf-test))) (defun debug-asdf () (setf *debug-asdf* t) (setf *package* (find-package :asdf-test))) -(defun common-lisp-user::load-asdf () (load-asdf)) -(defun common-lisp-user::debug-asdf () (debug-asdf)) -(defun common-lisp-user::da () (debug-asdf)) +;; Actual scripts rely on this function: +(defun common-lisp-user::load-asdf () (load-asdf)) + +;; These are shorthands for interactive debugging of test scripts: +(!a + common-lisp-user::debug-asdf debug-asdf + da debug-asdf common-lisp-user::da debug-asdf + la load-asdf common-lisp-user::la load-asdf) -#| The following form is sometimes useful to insert in compute-action-stamp to find out what's happening. -It depends on the DBG macro in contrib/debug.lisp, that you should load in your ASDF. +#| For the record, the following form is sometimes useful to insert in + asdf/plan:compute-action-stamp to find out what's happening. + 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)) |# diff --git a/test/test1.script b/test/test1.script index 63612b1c1..5ad1176d2 100644 --- a/test/test1.script +++ b/test/test1.script @@ -6,8 +6,9 @@ (touch-file "file1.lisp" :offset -3500) (touch-file "file2.lisp" :offset -3400) + (with-test () - (DBG "loading test1" #+clisp asdf/output-translations::*output-translations*) + (DBG "loading test1") (asdf:load-system 'test1) (let* ((file1 (asdf:compile-file-pathname* "file1")) (file2 (asdf:compile-file-pathname* "file2")) @@ -31,7 +32,7 @@ (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 (<= then (file-write-date file2))) + (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 @@ -42,4 +43,4 @@ (asdf:clear-system 'test1) (asdf:operate 'asdf:load-op 'test1) (DBG :foo (file-write-date file2) before) - (assert (>= (file-write-date file2) before))))) + (assert-compare (>= (file-write-date file2) before))))) diff --git a/upgrade.lisp b/upgrade.lisp index ea5b1744c..8f6a0aa5e 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -35,7 +35,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26.93") + (asdf-version "2.26.94") (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) diff --git a/utility.lisp b/utility.lisp index b42f24f23..be863b4e6 100644 --- a/utility.lisp +++ b/utility.lisp @@ -5,14 +5,11 @@ (:recycle :asdf/utility :asdf) (:use :common-lisp :asdf/package :asdf/compatibility) (:export - #:find-symbol* ;; reexport from asdf/package - #:asdf-debug #:load-asdf-debug-utility ;; magic helper to define debugging functions - #:strcat #:compatfmt ;; reexport from asdf/compatibility - #:undefine-function #:undefine-functions - #:defun* #:defgeneric* ;; defining macros + ;; magic helper to define debugging functions: + #:asdf-debug #:load-asdf-debug-utility #:*asdf-debug-utility* + #:undefine-function #:undefine-functions #:defun* #:defgeneric* ;; (un)defining functions #:if-bind ;; basic flow control - #:while-collecting #:appendf #:length=n-p ;; lists - #:remove-keys #:remove-keyword ;; keyword argument lists + #:while-collecting #:appendf #:length=n-p #:remove-keys #:remove-keyword ;; lists and plists #:emptyp ;; sequences #:first-char #:last-char #:split-string ;; strings #:string-prefix-p #:string-enclosed-p #:string-suffix-p @@ -148,10 +145,10 @@ any of the characters in the sequence SEPARATOR. If MAX is specified, then no more than max(1,MAX) components will be returned, starting the separation from the end, e.g. when called with arguments \"a.b.c.d.e\" :max 3 :separator \".\" it will return (\"a.b.c\" \"d\" \"e\")." - (catch nil + (block () (let ((list nil) (words 0) (end (length string))) (flet ((separatorp (char) (find char separator)) - (done () (throw nil (cons (subseq string 0 end) list)))) + (done () (return (cons (subseq string 0 end) list)))) (loop :for start = (if (and max (>= words (1- max))) (done) @@ -224,7 +221,7 @@ starting the separation from the end, e.g. when called with arguments "Evaluate a form read from a string." (eval (read-from-string string))) -(defun* ensure-function (fun &key (package :asdf)) +(defun* ensure-function (fun &key (package :cl)) (etypecase fun ((or boolean keyword character number pathname) (constantly fun)) ((or function symbol) fun) @@ -251,18 +248,17 @@ Return a (non-null) list of integers if the string is valid, NIL otherwise. If on-error is error, warn, or designates a function of compatible signature, the function is called with an explanation of what is wrong with the argument. NB: ignores leading zeroes, and so doesn't distinguish between 2.003 and 2.3" - (and - (or (stringp string) - (when on-error - (funcall on-error "~S: ~S is not a string" - 'parse-version string)) nil) - (or (loop :for prev = nil :then c :for c :across string - :always (or (digit-char-p c) - (and (eql c #\.) prev (not (eql prev #\.)))) - :finally (return (and c (digit-char-p c)))) - (when on-error - (funcall on-error "~S: ~S doesn't follow asdf version numbering convention" - 'parse-version string)) nil) + (block nil + (unless (stringp string) + (call-function on-error "~S: ~S is not a string" 'parse-version string) + (return)) + (unless (loop :for prev = nil :then c :for c :across string + :always (or (digit-char-p c) + (and (eql c #\.) prev (not (eql prev #\.)))) + :finally (return (and c (digit-char-p c)))) + (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" + 'parse-version string) + (return)) (mapcar #'parse-integer (split-string string :separator ".")))) (defun* unparse-version (version-list) diff --git a/version.lisp-expr b/version.lisp-expr index 91cc49c04..160cf57a5 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.93" +"2.26.94" -- GitLab