Commit 79ee5917 authored by Robert Goldman's avatar Robert Goldman
Browse files

Add test for gitlab issue #6.

Stelian reported that he was unable to find systems through link
farm on ECL if the link farm was installed by source configuration.

This attempts to confirm that.
parent 0647472b
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
(in-package :asdf) (in-package :asdf)
(use-package :asdf-test) (use-package :asdf-test)
(import '(asdf-test::DBG))
(defparameter *tmp-directory* (subpathname *asdf-directory* "build/")) (defparameter *tmp-directory* (subpathname *asdf-directory* "build/"))
(setf *central-registry* nil) (setf *central-registry* nil)
...@@ -93,8 +94,15 @@ ...@@ -93,8 +94,15 @@
(:include ,(under-tmp-directory "dir9/dira/")) (:include ,(under-tmp-directory "dir9/dira/"))
:ignore-inherited-configuration)) :ignore-inherited-configuration))
(format t "~&Source Registry: ~S~%" (defun dump-source-registry ()
asdf::*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)))
(assert (find-system :foo0 nil)) (assert (find-system :foo0 nil))
(assert (find-system :foo1 nil)) (assert (find-system :foo1 nil))
(assert (find-system :foo2 nil)) (assert (find-system :foo2 nil))
...@@ -111,3 +119,41 @@ ...@@ -111,3 +119,41 @@
(under-tmp-directory "dir2/bar/baz.lisp")) (under-tmp-directory "dir2/bar/baz.lisp"))
(assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-tmp-directory "dir2/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 ()
: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*)
;;; test following symlinks
`(:source-registry (:include ,(namestring *link-farm-directory*))
(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 @@ ...@@ -55,7 +55,7 @@
(assert (asdf:find-system :loop))) (assert (asdf:find-system :loop)))
;; clean up ;; clean up
(DBG "Cleaning 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") (DBG "Exiting")
(exit-lisp 0) (exit-lisp 0)
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