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

2.20.12: avoid a forward reference by shuffling some functions around.

Make logical pathname test work on disjoint files, for now.
Fix test-upgrade wrt recent package tweak in testing.
parent 89a08756
......@@ -87,7 +87,7 @@ test-upgrade:
ll="(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning)) (format t \"ll~%\") (load \"asdf.lisp\"))" ; \
cf="(handler-bind ((warning #'muffle-warning)) (format t \"cf~%\") (compile-file \"asdf.lisp\" :output-file \"$$fa\" :verbose t :print t))" ; \
lf="(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning)) (format t \"lf\") (load \"$$fa\" :verbose t :print t))" ; \
te="(quit-on-error $$l (push #p\"${sourceDirectory}/test/\" asdf:*central-registry*) (princ \"te\") (asdf:oos 'asdf:load-op :test-module-depend :verbose t))" ; \
te="(asdf-test::quit-on-error $$l (push #p\"${sourceDirectory}/test/\" asdf:*central-registry*) (princ \"te\") (asdf:oos 'asdf:load-op :test-module-depend :verbose t))" ; \
use_ccl () { li="${CCL} --no-init --quiet --load" ; ev="--eval" ; } ; \
use_clisp () { li="${CLISP} -norc -ansi --quiet --quiet -i" ; ev="-x" ; } ; \
use_sbcl () { li="${SBCL} --noinform --no-userinit --load" ; ev="--eval" ; } ; \
......
......@@ -14,7 +14,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.20.11" ;; to be automatically updated by bin/bump-revision
:version "2.20.12" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components
((:file "asdf")
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.20.11: Another System Definition Facility.
;;; This is ASDF 2.20.12: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......@@ -115,7 +115,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.20.11")
(asdf-version "2.20.12")
(existing-asdf (find-class 'component nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
......@@ -773,6 +773,56 @@ actually-existing directory."
(and (typep pathspec '(or pathname string))
(eq :absolute (car (pathname-directory (pathname pathspec))))))
(defun* coerce-pathname (name &key type defaults)
"coerce NAME into a PATHNAME.
When given a string, portably decompose it into a relative pathname:
#\\/ separates subdirectories. The last #\\/-separated string is as follows:
if TYPE is NIL, its last #\\. if any separates name and type from from type;
if TYPE is a string, it is the type, and the whole string is the name;
if TYPE is :DIRECTORY, the string is a directory component;
if the string is empty, it's a directory.
Any directory named .. is read as :BACK.
Host, device and version components are taken from DEFAULTS."
;; The defaults are required notably because they provide the default host
;; to the below make-pathname, which may crucially matter to people using
;; merge-pathnames with non-default hosts, e.g. for logical-pathnames.
;; NOTE that the host and device slots will be taken from the defaults,
;; but that should only matter if you later merge relative pathnames with
;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
(etypecase name
((or null pathname)
name)
(symbol
(coerce-pathname (string-downcase name) :type type :defaults defaults))
(string
(multiple-value-bind (relative path filename)
(component-name-to-pathname-components name :force-directory (eq type :directory)
:force-relative t)
(multiple-value-bind (name type)
(cond
((or (eq type :directory) (null filename))
(values nil nil))
(type
(values filename type))
(t
(split-name-type filename)))
(apply 'make-pathname :directory (cons relative path) :name name :type type
(when defaults `(:defaults ,defaults))))))))
(defun* merge-component-name-type (name &key type defaults)
;; For backwards compatibility only, for people using internals.
;; Will be removed in a future release, e.g. 2.016.
(warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
(coerce-pathname name :type type :defaults defaults))
(defun* subpathname (pathname subpath &key type)
(and pathname (merge-pathnames* (coerce-pathname subpath :type type)
(pathname-directory-pathname pathname))))
(defun subpathname* (pathname subpath &key type)
(and pathname
(subpathname (ensure-directory-pathname pathname) subpath :type type)))
(defun* length=n-p (x n) ;is it that (= (length x) n) ?
(check-type n (integer 0 *))
(loop
......@@ -1602,9 +1652,9 @@ Going forward, we recommend new users should be using the source-registry.
(defun* probe-asd (name defaults)
(block nil
(when (directory-pathname-p defaults)
(let ((file (subpathname defaults (strcat name ".asd"))))
(when (probe-file* file)
(return file)))
(let* ((file (probe-file* (subpathname defaults (strcat name ".asd")))))
(when file)
(return file))
#-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!)
(when (os-windows-p)
(let ((shortcut
......@@ -1862,48 +1912,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(declare (ignorable s))
(source-file-explicit-type component))
(defun* coerce-pathname (name &key type defaults)
"coerce NAME into a PATHNAME.
When given a string, portably decompose it into a relative pathname:
#\\/ separates subdirectories. The last #\\/-separated string is as follows:
if TYPE is NIL, its last #\\. if any separates name and type from from type;
if TYPE is a string, it is the type, and the whole string is the name;
if TYPE is :DIRECTORY, the string is a directory component;
if the string is empty, it's a directory.
Any directory named .. is read as :BACK.
Host, device and version components are taken from DEFAULTS."
;; The defaults are required notably because they provide the default host
;; to the below make-pathname, which may crucially matter to people using
;; merge-pathnames with non-default hosts, e.g. for logical-pathnames.
;; NOTE that the host and device slots will be taken from the defaults,
;; but that should only matter if you later merge relative pathnames with
;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
(etypecase name
((or null pathname)
name)
(symbol
(coerce-pathname (string-downcase name) :type type :defaults defaults))
(string
(multiple-value-bind (relative path filename)
(component-name-to-pathname-components name :force-directory (eq type :directory)
:force-relative t)
(multiple-value-bind (name type)
(cond
((or (eq type :directory) (null filename))
(values nil nil))
(type
(values filename type))
(t
(split-name-type filename)))
(apply 'make-pathname :directory (cons relative path) :name name :type type
(when defaults `(:defaults ,defaults))))))))
(defun* merge-component-name-type (name &key type defaults)
;; For backwards compatibility only, for people using internals.
;; Will be removed in a future release, e.g. 2.016.
(warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
(coerce-pathname name :type type :defaults defaults))
(defmethod component-relative-pathname ((component component))
(coerce-pathname
(or (slot-value component 'relative-pathname)
......@@ -1911,14 +1919,6 @@ Host, device and version components are taken from DEFAULTS."
:type (source-file-type component (component-system component))
:defaults (component-parent-pathname component)))
(defun* subpathname (pathname subpath &key type)
(and pathname (merge-pathnames* (coerce-pathname subpath :type type)
(pathname-directory-pathname pathname))))
(defun subpathname* (pathname subpath &key type)
(and pathname
(subpathname (ensure-directory-pathname pathname) subpath :type type)))
;;;; -------------------------------------------------------------------------
;;;; Operations
......@@ -3163,8 +3163,8 @@ located."
#+clozure
(defun* ccl-fasl-version ()
;; the fasl version is target-dependent from CCL 1.8 on.
(or (and (fboundp 'ccl::target-fasl-version)
(funcall 'ccl::target-fasl-version))
(or (let ((s 'ccl::target-fasl-version))
(and (fboundp s) (funcall s)))
(and (boundp 'ccl::fasl-version)
(symbol-value 'ccl::fasl-version))
(error "Can't determine fasl version.")))
......
(defpackage :test-package (:use :cl))
(in-package :test-package)
(defvar *logical-file* t)
;;; -*- Lisp -*-
(defsystem test-logical-pathname
:components
((:file "logical-file")))
......@@ -20,24 +20,24 @@
(format t "Test logical pathnames in central registry~%")
(setf *central-registry* '(#p"ASDF:test;"))
(initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(load-system :test-force :force t))
(load-system :test-logical-pathname :force t))
(progn
(format t "Test logical pathnames in source-registry, non-recursive~%")
(clear-system :test-force)
(clear-system :test-logical-pathname)
(setf *central-registry* '())
(initialize-source-registry
'(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
(load-system :test-force :force t))
(load-system :test-logical-pathname :force t))
(progn
(format t "Test logical pathnames in source-registry, recursive~%")
(clear-system :test-force)
(clear-system :test-logical-pathname)
(setf *central-registry* '())
(initialize-source-registry
;; Bug: Allegro Express 8.2 incorrectly reads #p"ASDF:" as relative.
'(:source-registry (:tree #-allegro #p"ASDF:" #+allegro #.(asdf::pathname-root #p"ASDF:"))
:ignore-inherited-configuration))
(load-system :test-force :force t))
(load-system :test-logical-pathname :force t))
(format t "Done~%"))
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