Commit a0cb306d authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'test-link-farm' into 'master'

Test link farm

See merge request asdf/asdf!129
parents 386cb483 79ee5917
......@@ -2,6 +2,7 @@
(in-package :asdf)
(use-package :asdf-test)
(import '(asdf-test::DBG))
(defparameter *tmp-directory* (subpathname *asdf-directory* "build/"))
(setf *central-registry* nil)
......@@ -93,8 +94,15 @@
(:include ,(under-tmp-directory "dir9/dira/"))
:ignore-inherited-configuration))
(format t "~&Source Registry: ~S~%"
asdf::*source-registry*)
(defun dump-source-registry ()
(format t "~&Source Registry:~%")
(loop :for k :being :each hash-key :of *source-registry*
:using (hash-value v)
:do (format t "~a --> ~a~%" k v)))
(dump-source-registry)
(assert (find-system :foo0 nil))
(assert (find-system :foo1 nil))
(assert (find-system :foo2 nil))
......@@ -111,3 +119,41 @@
(under-tmp-directory "dir2/bar/baz.lisp"))
(assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-tmp-directory "dir2/bar/baz.lisp"))
(DBG "Testing link farm found through source registry.")
(defparameter *link-farm-directory* (under-tmp-directory "link-farm/"))
(defun link-asd-files ()
(loop
:for d :in *tmp-asd-directories*
:for i :from 0
:as asd-file = (merge-pathnames* (format nil "foo~D.asd" i) d)
:do (assert (probe-file asd-file))
(run-program (format nil "ln -s ~a ~a" (namestring asd-file) (namestring *link-farm-directory*)))))
;;; prepare for link farm test
;; clean up first
(describe *link-farm-directory*)
(uiop:delete-directory-tree *link-farm-directory* :validate (lambda (x) (subpathp x *tmp-directory*)))
;; create the link farm
(ensure-directories-exist *link-farm-directory*)
(link-asd-files)
;;; test following symlinks
(initialize-source-registry
`(:source-registry (:include ,(namestring *link-farm-directory*))
:ignore-inherited-configuration))
(dump-source-registry)
(assert (find-system :foo0 nil))
(assert (find-system :foo1 nil))
(assert (find-system :foo2 nil))
(assert (find-system :foo3 nil))
(assert (find-system :foo4 nil))
(assert (not (find-system :foo5 nil)))
(assert (find-system :foo6 nil))
(assert (find-system :foo7 nil))
(assert (find-system :foo8 nil))
(assert (not (find-system :foo9 nil)))
......@@ -55,7 +55,7 @@
(assert (asdf:find-system :loop)))
;; clean up
(DBG "Cleaning up")
(uiop:run-program (format nil "rm -r ~a" scratch-dir))))
(uiop:delete-directory-tree scratch-dir :validate (lambda (x) (subpathp x *test-directory*)))))
(DBG "Exiting")
(exit-lisp 0)
......@@ -648,11 +648,10 @@ the validation function designated (as per ENSURE-FUNCTION) by the VALIDATE keyw
which in practice is thus compulsory, and validates by returning a non-NIL result.
If you're suicidal or extremely confident, just use :VALIDATE T."
(check-type if-does-not-exist (member :error :ignore))
(setf directory-pathname (ensure-pathname directory-pathname
:want-pathname t :want-non-wild t
:want-physical t :want-directory t))
(cond
((not (and (pathnamep directory-pathname) (directory-pathname-p directory-pathname)
(physical-pathname-p directory-pathname) (not (wild-pathname-p directory-pathname))))
(parameter-error "~S was asked to delete ~S but it is not a physical non-wildcard directory pathname"
'delete-directory-tree directory-pathname))
((not validatep)
(parameter-error "~S was asked to delete ~S but was not provided a validation predicate"
'delete-directory-tree directory-pathname))
......
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