Commit 5a520005 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.31.1: require-system, a class for systems that use (REQUIRE ...)

Based on a patch by Stelian Ionescu.
parent 029ebf87
* have a mode to explain WHY a module needs to be recompiled.
* have a better defsystem form verifier - see lp#1007335
* have a function verify-strict-asd that can verify a asd is pure lp#541562
Then if it passes, use load-strict-asd.
......
......@@ -74,7 +74,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.31" ;; to be automatically updated by make bump-version
:version "2.31.1" ;; 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.
......
......@@ -22,13 +22,13 @@
(setf (gethash key *asdf-cache*) value-list)
value-list)))
(defun consult-asdf-cache (key thunk)
(defun consult-asdf-cache (key &optional thunk)
(if *asdf-cache*
(multiple-value-bind (results foundp) (gethash key *asdf-cache*)
(if foundp
(apply 'values results)
(set-asdf-cache-entry key (multiple-value-list (funcall thunk)))))
(funcall thunk)))
(set-asdf-cache-entry key (multiple-value-list (call-function thunk)))))
(call-function thunk)))
(defmacro do-asdf-cache (key &body body)
`(consult-asdf-cache ,key #'(lambda () ,@body)))
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.31: Another System Definition Facility.
;;; This is ASDF 2.31.1: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -140,18 +140,48 @@ for how to load or compile stuff")
(defun require-system (s &rest keys &key &allow-other-keys)
(apply 'load-system s :force-not (already-loaded-systems) keys))
(defvar *modules-being-required* nil)
(defclass require-system (system)
((module :initarg :module :initform nil :accessor required-module)))
(defmethod perform ((o compile-op) (c require-system))
(declare (ignorable o c))
nil)
(defmethod perform ((o load-op) (s require-system))
(declare (ignorable o))
(let* ((module (or (required-module s) (coerce-name s)))
(*modules-being-required* (cons module *modules-being-required*)))
(assert (null (component-children s)))
(require module)))
(defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments)
(declare (ignorable component combinator))
(unless (length=n-p arguments 1)
(error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>")
(cons combinator arguments) component combinator))
(let* ((module (car arguments))
(name (string-downcase module)))
(assert module)
(make-instance 'require-system :name name)))
(defun module-provide-asdf (name)
(handler-bind
((style-warning #'muffle-warning)
(missing-component (constantly nil))
(error #'(lambda (e)
(format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%")
name e))))
(let ((*verbose-out* (make-broadcast-stream))
(system (find-system (string-downcase name) nil)))
(when system
(require-system system :verbose nil)
t)))))
(let ((module (string-downcase name)))
(unless (member module *modules-being-required* :test 'equal)
(let ((*modules-being-required* (cons module *modules-being-required*))
#+sbcl (sb-impl::*requiring* (remove module sb-impl::*requiring* :test 'equal)))
(handler-bind
((style-warning #'muffle-warning)
(missing-component (constantly nil))
(error #'(lambda (e)
(format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%")
name e))))
(let ((*verbose-out* (make-broadcast-stream)))
(let ((system (find-system module nil)))
(when system
(require-system system :verbose nil)
t)))))))))
;;;; Some upgrade magic
......
......@@ -263,27 +263,27 @@ effectively disabling the output translation facility."
(initialize-output-translations)))
(defun* (apply-output-translations) (path)
#+cormanlisp (resolve-symlinks* path) #-cormanlisp
(etypecase path
(logical-pathname
path)
((or pathname string)
(ensure-output-translations)
(loop* :with p = (resolve-symlinks* path)
:for (source destination) :in (car *output-translations*)
:for root = (when (or (eq source t)
(and (pathnamep source)
(not (absolute-pathname-p source))))
(pathname-root p))
:for absolute-source = (cond
((eq source t) (wilden root))
(root (merge-pathnames* source root))
(t source))
:when (or (eq source t) (pathname-match-p p absolute-source))
:return (translate-pathname* p absolute-source destination root source)
:finally (return p)))))
(etypecase path
(logical-pathname
path)
((or pathname string)
(ensure-output-translations)
(loop* :with p = (resolve-symlinks* path)
:for (source destination) :in (car *output-translations*)
:for root = (when (or (eq source t)
(and (pathnamep source)
(not (absolute-pathname-p source))))
(pathname-root p))
:for absolute-source = (cond
((eq source t) (wilden root))
(root (merge-pathnames* source root))
(t source))
:when (or (eq source t) (pathname-match-p p absolute-source))
:return (translate-pathname* p absolute-source destination root source)
:finally (return p)))))
;; Hook into asdf/driver's output-translation mechanism
#-cormanlisp
(setf *output-translation-function* 'apply-output-translations)
#+abcl
......
......@@ -176,7 +176,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
:do (loop :with dep-o = (find-operation operation dep-o-spec)
:for dep-c-spec :in dep-c-specs
:for dep-c = (resolve-dependency-spec component dep-c-spec)
:do (funcall fun dep-o dep-c))))
:when (and dep-o dep-c)
:do (funcall fun dep-o dep-c))))
(defun reduce-direct-dependencies (operation component combinator seed)
(map-direct-dependencies
......
......@@ -30,6 +30,7 @@
:depends-on ((:version :test-asdf/test9-2 "2.0")))
(defsystem :test-asdf/test-module-depend
:depends-on (#+sbcl (:require :sb-posix))
:components
((:file "file1")
(:module "quux"
......
......@@ -40,8 +40,10 @@
(leave-test "No Unicode support to test on this lisp implementation" 0)
#+abcl
(when (version< (lisp-implementation-version) "1.1.2")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0))
(let ((version (lisp-implementation-version))
(version-nums (subseq version 0 (position-if-not (lambda (x) (find x "0123456789.")) version))))
(when (version< version-nums "1.1.2")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))
(with-encoding-test (:utf-8)
(def-test-system :test-encoding-explicit-u8
......
......@@ -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.31")
(asdf-version "2.31.1")
(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