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

Merge branch 'master' into minimakefile

parents 65ba6c0f af5653d2
......@@ -75,7 +75,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "3.1.5.5" ;; to be automatically updated by make bump-version
:version "3.1.5.6" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
:class #+asdf3.1 package-inferred-system #-asdf3.1 system
......
......@@ -1924,6 +1924,12 @@ and has many options that prove useful in this context,
such as @code{:use-reexport} and @code{:mix-reexport}
that allow for ``inheritance'' of symbols being exported.
Note that starting with ASDF 3.1.5.6 only, ASDF will look for source files under
the @code{component-pathname} as specified via the @code{:pathname} option,
whereas earlier versions ignore this option and use the @code{system-source-directory}
where the @file{.asd} file resides.
@node The object model of ASDF, Controlling where ASDF searches for systems, Defining systems with defsystem, Top
@comment node-name, next, previous, up
@chapter The Object model of ASDF
......
This diff is collapsed.
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.5.5: Another System Definition Facility.
;;; This is ASDF 3.1.5.6: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -111,7 +111,7 @@ otherwise return a default system name computed from PACKAGE-NAME."
(unless (equal primary system)
(let ((top (find-system primary nil)))
(when (typep top 'package-inferred-system)
(if-let (dir (system-source-directory top))
(if-let (dir (component-pathname top))
(let* ((sub (subseq system (1+ (length primary))))
(f (probe-file* (subpathname dir sub :type "lisp")
:truename *resolve-symlinks*)))
......
......@@ -20,7 +20,7 @@
#:default-user-source-registry #:default-system-source-registry
#:user-source-registry #:system-source-registry
#:user-source-registry-directory #:system-source-registry-directory
#:environment-source-registry #:process-source-registry
#:environment-source-registry #:process-source-registry #:inherit-source-registry
#:compute-source-registry #:flatten-source-registry
#:sysdef-source-registry-search))
(in-package :asdf/source-registry)
......@@ -43,6 +43,8 @@
"Either NIL (for uninitialized), or an equal hash-table, mapping
system names to pathnames of .asd files")
(defvar *source-registry-parameter* nil)
(defun source-registry-initialized-p ()
(typep *source-registry* 'hash-table))
......@@ -264,7 +266,7 @@ after having found a .asd file? True by default.")
(dolist (directive (cdr (validate-source-registry-form form)))
(process-source-registry-directive directive :inherit inherit :register register))))
(defun flatten-source-registry (&optional parameter)
(defun flatten-source-registry (&optional (parameter *source-registry-parameter*))
(remove-duplicates
(while-collecting (collect)
(with-pathname-defaults () ;; be location-independent
......@@ -277,7 +279,7 @@ after having found a .asd file? True by default.")
:test 'equal :from-end t))
;; Will read the configuration and initialize all internal variables.
(defun compute-source-registry (&optional parameter (registry *source-registry*))
(defun compute-source-registry (&optional (parameter *source-registry-parameter*) (registry *source-registry*))
(dolist (entry (flatten-source-registry parameter))
(destructuring-bind (directory &key recurse exclude) entry
(let* ((h (make-hash-table :test 'equal))) ; table to detect duplicates
......@@ -307,8 +309,6 @@ after having found a .asd file? True by default.")
h)))
(values))
(defvar *source-registry-parameter* nil)
(defun initialize-source-registry (&optional (parameter *source-registry-parameter*))
;; Record the parameter used to configure the registry
(setf *source-registry-parameter* parameter)
......
......@@ -42,11 +42,10 @@ Some constraints:
(proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
#+(or cmu scl) (c::brevity 2) #+(or cmu scl) (ext:inhibit-warnings 3)))
(defvar *trace-symbols*
(defparameter *trace-symbols*
`(;; If you want to trace some stuff while debugging ASDF,
;; here's a nice place to say what.
;; These string designators will be interned in ASDF after it is loaded.
;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*)
))
......@@ -428,7 +427,7 @@ is bound, write a message and exit on an error. If
(defmacro with-asdf-conditions ((&optional verbose) &body body)
`(call-with-asdf-conditions #'(lambda () ,@body) ,verbose))
(defun compile-asdf (&optional tag verbose upgradep)
(defun compile-asdf (&optional tag (verbose nil) upgradep)
(let* ((alisp (asdf-lisp tag))
(afasl (asdf-fasl tag))
(tmp (make-pathname :name "asdf-tmp" :defaults afasl)))
......@@ -551,6 +550,13 @@ is bound, write a message and exit on an error. If
(load-asdf-lisp)
(clean-asdf-system))
(defun hash-table-alist (h)
(loop for k being the hash-keys of h using (hash-value v) collect (cons k v)))
(defun registry ()
(let ((sr (asymval :*source-registry*)))
(when sr (sort (hta sr) 'string< :key 'car))))
(defun configure-asdf ()
(format t "Configuring ASDF~%")
(when (asym :getenvp)
......
......@@ -78,8 +78,7 @@
(load-system :asdf-encodings)
(with-expected-failure (#+lispworks "LispWorks doesn't have LATIN-2"
#+ecl "ECL recently broke its encoding support") ;; Check that it indeed still is broken before we punt.
(with-expected-failure (#+lispworks "LispWorks doesn't have LATIN-2") ;; Check that it indeed still is broken before we punt.
(with-encoding-test (:latin-2)
(def-test-system :test-encoding-implicit-autodetect
:components ((:file "lambda")))))
......
......@@ -62,6 +62,7 @@
#-(and sbcl os-windows)
(let ((ok1 (format nil "; $ echo ok 1~%ok 1")))
(untrace)
(DBG "Testing awkward legacy output capture via run-shell-command")
(assert-equal
(dewindowize
......@@ -166,29 +167,27 @@ Testing run-program
t)
(defun common-test/run-program ()
;; Can we echo a simple string?
(DBG "Can we echo a simple string?")
(assert-equal '("abcde") (run-program '("echo" "abcde") :output :lines))
(assert-equal (nl "fghij") (run-program '("echo" "fghij") :output :string))
;; Are spaces handled properly?
(DBG "Are spaces handled properly?")
(assert-equal '("Hello World") (run-program '("echo" "Hello World") :output :lines))
(assert-equal (nl "Hello World") (run-program '("echo" "Hello World") :output :string))
(assert-equal (nl "Hello World") (run-program "echo Hello World" :output :string))
;; Test that run-program fails properly with an empty program string
(DBG "Test that run-program fails properly with an empty program string")
#+(or clozure (and allegro os-unix) cmu (and lispworks os-unix) sbcl scl)
(signals error (run-program '("") :output :lines))
;; An empty string itself is ok since it is passed to the shell.
(DBG "An empty string itself is ok since it is passed to the shell.")
(assert-equal "" (run-program "" :output :string))
;; Test that run-program fails properly with a
;; nil program list
(DBG "Test that run-program fails properly with a nil program list")
#+(or clozure (and allegro os-unix) cmu sbcl scl)
(signals error (run-program nil :output :lines))
;; Test that run-program fails properly when the
;; executable doesn't exist.
(DBG "Test that run-program fails properly when the executable doesn't exist.")
(signals error (run-program '("does-not-exist") :output :lines))
(signals error (run-program "does-not-exist" :output :lines))
......@@ -199,14 +198,17 @@ Testing run-program
(defun unix-only-test/run-program ()
(DBG "Checking that spaces between arguments are collapsed by shell when and only when unquoted")
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
(assert-equal '("ok 1") (run-program '("echo" "ok 1") :output :lines))
(assert-equal "ok 1" (run-program '("echo" "ok 1") :output '(:string :stripped t)))
(DBG "Checking behavior on program success or failure")
(assert-equal '(nil nil 0) (multiple-value-list (run-program "true")))
(signals subprocess-error (run-program "false"))
(assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :ignore-error-status t)))
(DBG "Tests with test-file")
(let ((tf (native-namestring (test-source "test-file"))))
;; a basic smoke test
......@@ -254,5 +256,4 @@ Testing run-program
(terpri)
t)
(test/run-program)
......@@ -345,7 +345,7 @@ also \"Configuration DSL\"\) in the ASDF manual."
(resolve-absolute-location
`(,(or (getenv-absolute-directory "XDG_CACHE_HOME")
(os-cond
((os-windows-p) (xdg-data-home "cache"))
((os-windows-p) (xdg-data-home "cache/"))
(t (subpathname* (user-homedir-pathname) ".cache/"))))
,more)))
......
......@@ -67,7 +67,7 @@ previously-loaded version of ASDF."
;; "3.4.5.67" would be a development version in the official branch, on top 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 "3.1.5.5")
(asdf-version "3.1.5.6")
(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