Commit 927e8770 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.132: enable pathname designator DSL for source-registry.

Also, allow for upgradability from old ASDF versions that don't have system-source-file.
parent 713dbc5e
This diff is collapsed.
......@@ -1752,6 +1752,29 @@ DIRECTIVE :=
;; This directive specifies that some default must be spliced.
:default-registry
REGULAR-FILE-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a file
DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name
PATHNAME-DESIGNATOR :=
NULL | ;; Special: skip this entry.
ABSOLUTE-COMPONENT-DESIGNATOR |
(ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...)
ABSOLUTE-COMPONENT-DESIGNATOR :=
STRING | ;; namestring (better be absolute or bust, directory assumed where applicable)
PATHNAME | ;; pathname (better be an absolute path, or bust)
:HOME | ;; designates the user-homedir-pathname ~/
:USER-CACHE | ;; designates the default location for the user cache
:SYSTEM-CACHE ;; designates the default location for the system cache
RELATIVE-COMPONENT-DESIGNATOR :=
STRING | ;; namestring (directory assumed where applicable)
PATHNAME | ;; pathname
:IMPLEMENTATION | ;; a directory based on implementation, e.g. sbcl-1.0.32.30-linux-x86-64
:IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl
:UID | ;; current UID -- not available on Windows
:USER ;; current USER name -- NOT IMPLEMENTED(!)
PATTERN := a string without wildcards, that will be matched exactly
against the name of a any subdirectory in the directory component
of a path. e.g. @code{"_darcs"} will match @file{#p"/foo/bar/_darcs/src/bar.asd"}
......@@ -1762,7 +1785,7 @@ which is the default place ASDF looks for this configuration,
once contained:
@example
(:source-registry
(:tree "/home/fare/cl/")
(:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/"
:inherit-configuration)
@end example
......
......@@ -278,6 +278,15 @@
(asdf:initialize-output-translations)
(format t "output translations: ~S~%" (asdf::output-translations))
#-(or clisp ecl) ; clisp has problem with the first one having :version :newest
(progn ; 1- we're testing with unix, are we not?
(assert (equal (asdf::resolve-location '(:home)) (truename (user-homedir-pathname))))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz")) #p"/foo/bar/baz"))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz") :directory t) #p"/foo/bar/baz/"))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz") :directory t :wilden t) (asdf::wilden #p"/foo/bar/baz/")))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz") :directory nil :wilden t) (asdf::wilden #p"/foo/bar/")))
(assert (equal (asdf::resolve-location '("/foo" "bar" #p"**/" "baz" #p"*.*") :directory nil :wilden t) #p"/foo/bar/**/baz/*.*")))
(or (test-component-pathnames :delete-host t :support-string-pathnames nil)
(leave-lisp "test failed" 1)))
......
......@@ -21,6 +21,7 @@
(compile-file *asdf-lisp* :output-file tmp :print t :verbose t))
(declare (ignore result))
(cond
#-ecl ; 10.7.1 has spurious warnings. Sigh.
(warnings-p
(leave-lisp "Testsuite failed: ASDF compiled with warnings" 1))
(errors-p
......
......@@ -2,3 +2,7 @@
(in-package :test-package)
(defvar *file-tmp* t)
(eval-when (:compile-toplevel :execute)
(format t "compiling level1/file1~%"))
(eval-when (:load-toplevel :execute)
(format t "loading level1/file1~%"))
;;; -*- Lisp -*-
(asdf:defsystem test-module-pathnames
(defsystem :test-module-pathnames
:components
((:module "sources/level1"
:serial t
:components
((:file "file1")
(:file "level2/file2")
(:static-file "level2/static.file")
(:static-file "test-tmp.cl")))))
:components
((:file "file1")
(:file "level2/file2")
(:static-file "level2/static.file")
(:static-file "test-tmp.cl")))))
......@@ -4,6 +4,7 @@
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(trace asdf:perform)
(asdf:load-system 'test-module-pathnames)
(flet ((submodule (module name)
(find name (asdf:module-components module)
......@@ -17,19 +18,17 @@
(assert (member (pathname-foo (asdf:component-relative-pathname test-tmp))
'(((:relative) "test-tmp" "cl")
(nil "test-tmp" "cl")) :test 'equal)
nil
"Didn't get the name of test-tmp.cl right")
() "Didn't get the name of test-tmp.cl right")
(assert (equal
(pathname-foo (asdf:component-relative-pathname static))
'((:relative "level2") "static" "file"))
nil
"Didn't get the name of static.file right")))
(assert (find-package :test-package) nil
"package test-package not found")
(assert (find-symbol (symbol-name '*file-tmp*) :test-package) nil
"symbol `*file-tmp*` not found")
() "Didn't get the name of static.file right")))
(assert (find-package :test-package)
() "package test-package not found")
(assert (find-symbol (symbol-name '*file-tmp*) :test-package)
() "symbol `*file-tmp*` not found")
(assert (symbol-value (find-symbol (symbol-name '*file-tmp*) :test-package))
nil "symbol `*file-tmp*` has wrong value")
() "symbol `*file-tmp*` has wrong value")
#| ; must be adapted to ABL
(assert (probe-file (merge-pathnames
......
;; part of the test-module-pathnames test
(in-package #:test-package)
(defparameter *test-tmp-cl* t)
(eval-when (:compile-toplevel :execute)
(format t "compiling test-tmp.cl~%"))
(eval-when (:load-toplevel :execute)
(format t "loading test-tmp.cl~%"))
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