Commit 3e998b6c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.32.5: rename asdf-debug to uiop-debug. Fix the packaging of uiop wrt debug.

parent cd8db039
......@@ -74,7 +74,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.32.4" ;; to be automatically updated by make bump-version
:version "2.32.5" ;; 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.
......
......@@ -4,10 +4,10 @@
(load (make-pathname :name "prelude" :type "lisp" :defaults *load-pathname*)
:verbose nil :print nil)
(defpackage :asdf-builder (:use :cl :asdf/driver :asdf/operate :asdf :fare-utils :inferior-shell))
(defpackage :asdf-builder (:use :cl :uiop :asdf/operate :asdf :fare-utils :inferior-shell))
(in-package :asdf-builder)
(asdf-debug)
(uiop-debug)
(defun build-asdf ()
"Make sure asdf.lisp is built"
......@@ -104,7 +104,7 @@
(error "Destination ~S already exists, not taking chances - you can delete it yourself."
destination))
(ensure-directories-exist destination)
(run (format nil "cd ~S && cp -pHux ~{~S ~} ~S"
(run (format nil "cd ~S && cp -pHux --parents ~{~S ~} ~S"
/base/ /files/ /destination/) :show t)
(run (format nil "tar zcfC ~S ~S ~S/"
/tarball/ /build-dir/ name) :show t)
......@@ -113,8 +113,7 @@
(defun driver-files ()
(DBG :df
(list* "uiop.asd" "../asdf-driver.asd" "version.lisp-expr"
(system-source-files :uiop))))
(list* "uiop.asd" "asdf-driver.asd" (system-source-files :uiop))))
(defun driver-name ()
(format nil "uiop-~A" *version*))
(defun make-driver-tarball ()
......
;;;;; A few essential debugging utilities by Faré,
;;;;; to be loaded in the *PACKAGE* that you wish to debug.
;;
;; 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 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
;; that you may prefer to this one, with your customizations,
;; by setting the variable
;; asdf-utility:*asdf-debug-utility*
;; to a form that evaluates to a designator of the pathname to your file.
;; For instance, on a home directory shared via NFS with different names
;; 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*
'(asdf/pathname:subpathname (asdf/os:user-homedir) "lisp/debug-utils.lisp"))
;;; If ASDF is not loaded (for instance, when debugging ASDF itself),
;;; Try the below, fixing the pathname to point to this file:
(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"))))
|#
;;; Here we define the magic package-dependent feature.
;;; With it, you should be able to use #+DBG-/PACKAGE-NAME/
;;; to annotate your debug statements, e.g. upper-case #+DBG-ASDF
;;; This will be all upper-case even in lower-case lisps.
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((kw (read-from-string
(format nil ":DBG-~:@(~A~)" (package-name *package*)))))
(pushnew kw *features*)))
;;; Now for the debugging stuff itself.
;;; First, my all-purpose print-debugging macro
(defmacro DBG (tag &rest exprs)
"simple debug statement macro:
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 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"))
(thunk-var (gensym "THUNK")))
`(let ((,tag-var ,tag))
(flet ,(when exprs `((,thunk-var () ,last-expr)))
(if ,tag-var
(DBG-helper ,tag-var
(list ,@(loop :for x :in other-exprs :collect
`(cons ',x #'(lambda () ,x))))
',last-expr ,(if exprs `#',thunk-var nil))
,(if exprs `(,thunk-var) '(values)))))))
(defun DBG-helper (tag expressions-thunks last-expression last-thunk)
;; Helper for the above debugging macro
(labels
((f (stream fmt &rest args)
(with-standard-io-syntax
(let ((*print-readably* nil)
(*package* (find-package :cl)))
(apply 'format stream fmt args)
(finish-output stream))))
(z (stream)
(f stream "~&"))
(e (fmt arg)
(f *error-output* fmt arg))
(x (expression thunk)
(e "~& ~S => " expression)
(let ((results (multiple-value-list (funcall thunk))))
(e "~{~S~^ ~}~%" results)
(apply 'values results))))
(map () #'z (list *standard-output* *error-output* *trace-output*))
(e "~A~%" tag)
(loop :for (expression . thunk) :in expressions-thunks
:do (x expression thunk))
(if last-thunk
(x last-expression last-thunk)
(values))))
;;; Quick definitions for use at the REPL
(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)
`(defmacro ,alias (&rest x) `(,',name ,@x))
`(defun ,alias (&rest x) (apply ',name x))))))
;;; common aliases
(!a
d describe
ap apropos
!p defparameter
m1 macroexpand-1)
;;; SLIME integration
(when (find-package :swank)
(eval (read-from-string "(!a i swank:inspect-in-emacs)")))
../uiop/contrib/debug.lisp
\ No newline at end of file
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.32.4: Another System Definition Facility.
;;; This is ASDF 2.32.5: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -600,7 +600,7 @@ is bound, write a message and exit on an error. If
#| 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.
that you should load in your asdf/plan by inserting an (uiop-debug) form in it.
(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
......
../contrib
\ No newline at end of file
;;;;; A few essential debugging utilities by Faré,
;;;;; to be loaded in the *PACKAGE* that you wish to debug.
;;
;; 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 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
;; that you may prefer to this one, with your customizations,
;; by setting the variable
;; asdf-utility:*asdf-debug-utility*
;; to a form that evaluates to a designator of the pathname to your file.
;; For instance, on a home directory shared via NFS with different names
;; 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*
'(asdf/pathname:subpathname (asdf/os:user-homedir) "lisp/debug-utils.lisp"))
;;; If ASDF is not loaded (for instance, when debugging ASDF itself),
;;; Try the below, fixing the pathname to point to this file:
(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"))))
|#
;;; Here we define the magic package-dependent feature.
;;; With it, you should be able to use #+DBG-/PACKAGE-NAME/
;;; to annotate your debug statements, e.g. upper-case #+DBG-ASDF
;;; This will be all upper-case even in lower-case lisps.
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((kw (read-from-string
(format nil ":DBG-~:@(~A~)" (package-name *package*)))))
(pushnew kw *features*)))
;;; Now for the debugging stuff itself.
;;; First, my all-purpose print-debugging macro
(defmacro DBG (tag &rest exprs)
"simple debug statement macro:
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 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"))
(thunk-var (gensym "THUNK")))
`(let ((,tag-var ,tag))
(flet ,(when exprs `((,thunk-var () ,last-expr)))
(if ,tag-var
(DBG-helper ,tag-var
(list ,@(loop :for x :in other-exprs :collect
`(cons ',x #'(lambda () ,x))))
',last-expr ,(if exprs `#',thunk-var nil))
,(if exprs `(,thunk-var) '(values)))))))
(defun DBG-helper (tag expressions-thunks last-expression last-thunk)
;; Helper for the above debugging macro
(labels
((f (stream fmt &rest args)
(with-standard-io-syntax
(let ((*print-readably* nil)
(*package* (find-package :cl)))
(apply 'format stream fmt args)
(finish-output stream))))
(z (stream)
(f stream "~&"))
(e (fmt arg)
(f *error-output* fmt arg))
(x (expression thunk)
(e "~& ~S => " expression)
(let ((results (multiple-value-list (funcall thunk))))
(e "~{~S~^ ~}~%" results)
(apply 'values results))))
(map () #'z (list *standard-output* *error-output* *trace-output*))
(e "~A~%" tag)
(loop :for (expression . thunk) :in expressions-thunks
:do (x expression thunk))
(if last-thunk
(x last-expression last-thunk)
(values))))
;;; Quick definitions for use at the REPL
(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)
`(defmacro ,alias (&rest x) `(,',name ,@x))
`(defun ,alias (&rest x) (apply ',name x))))))
;;; common aliases
(!a
d describe
ap apropos
!p defparameter
m1 macroexpand-1)
;;; SLIME integration
(when (find-package :swank)
(eval (read-from-string "(!a i swank:inspect-in-emacs)")))
......@@ -12,7 +12,7 @@
#+ecl #:use-ecl-byte-compiler-p #+mcl #:probe-posix)
(:export
;; magic helper to define debugging functions:
#:asdf-debug #:load-asdf-debug-utility #:*asdf-debug-utility*
#:uiop-debug #:load-uiop-debug-utility #:*uiop-debug-utility*
#:undefine-function #:undefine-functions #:defun* #:defgeneric* #:with-upgradability ;; (un)defining functions
#:if-let ;; basic flow control
#:while-collecting #:appendf #:length=n-p #:remove-plist-keys #:remove-plist-key ;; lists and plists
......@@ -90,22 +90,22 @@
;;; Magic debugging help. See contrib/debug.lisp
(with-upgradability ()
(defvar *asdf-debug-utility*
(defvar *uiop-debug-utility*
'(or (ignore-errors
(symbol-call :asdf :system-relative-pathname :asdf "contrib/debug.lisp"))
(merge-pathnames "cl/asdf/contrib/debug.lisp" (user-homedir-pathname)))
(symbol-call :asdf :system-relative-pathname :uiop "contrib/debug.lisp"))
(symbol-call :uiop/pathname :subpathname (user-homedir-pathname) "cl/asdf/uiop/contrib/debug.lisp"))
"form that evaluates to the pathname to your favorite debugging utilities")
(defmacro asdf-debug (&rest keys)
(defmacro uiop-debug (&rest keys)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(load-asdf-debug-utility ,@keys)))
(load-uiop-debug-utility ,@keys)))
(defun load-asdf-debug-utility (&key package utility-file)
(defun load-uiop-debug-utility (&key package utility-file)
(let* ((*package* (if package (find-package package) *package*))
(keyword (read-from-string
(format nil ":DBG-~:@(~A~)" (package-name *package*)))))
(unless (member keyword *features*)
(let* ((utility-file (or utility-file *asdf-debug-utility*))
(let* ((utility-file (or utility-file *uiop-debug-utility*))
(file (ignore-errors (probe-file (eval utility-file)))))
(if file (load file)
(error "Failed to locate debug utility file: ~S" utility-file)))))))
......
......@@ -52,7 +52,7 @@ 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.32.4")
(asdf-version "2.32.5")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-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