1;;; -*- Lisp -*- 2 3(in-package :asdf) 4(use-package :asdf-test) 5(import '(asdf-test::DBG)) 6 7(defparameter *tmp-directory* (subpathname *asdf-directory* "build/")) 8(setf *central-registry* nil) 9 10(defun under-tmp-directory (designator &optional (defaults *tmp-directory*)) 11 (namestring (subpathname defaults designator))) 12 13(defun create-conf-files (&optional (path *tmp-directory*)) 14 (let ((v `(("conf.d/conf1.conf" 15 ((:directory ,(under-tmp-directory "dir1/")))) 16 ("conf.d/conf2.conf" 17 ((:tree ,(under-tmp-directory "dir2/")))) 18 ;; this is for testing the :here directive 19 ("dir5/conf.conf" 20 ((:directory (:here "dir6")))) 21 ("dir8/conf.conf" 22 ((:directory (:here)))) 23 ("dir9/dira/conf.conf" 24 ((:tree (:here))))))) 25 (loop 26 :for (file contents) :in v 27 :for name = (under-tmp-directory file path) 28 :do 29 (ensure-directories-exist name) 30 (with-open-file (out name 31 :direction :output 32 :if-exists :supersede) 33 (with-standard-io-syntax 34 (format out "~{~S~%~}" contents)))))) 35 36(defparameter *tmp-asd-directories* 37 (loop 38 :for dir 39 :in '("dir1/" ; foo0 40 "dir2/dir3/" ; foo1 41 "dir2/dir4/" ; foo2 42 "dir2/" ; foo3 43 ;; system here should be found because of :here directive 44 "dir5/dir6/" ; foo4 45 ;; system here should /not/ be found because of :here directive 46 "dir5/dir7/" ; foo5 47 "dir8/" ; foo6 48 "dir9/dira/" ; foo7 should be found because of :here :tree 49 "dir9/dira/dirc/" ; foo8 ditto 50 "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree 51 :collect (under-tmp-directory dir))) 52 53(defun create-asd-files () 54 (loop 55 :for d :in *tmp-asd-directories* 56 :for i :from 0 :do 57 (ensure-directories-exist d) 58 (with-open-file (s (merge-pathnames* (format nil "foo~D.asd" i) d) 59 :direction :output 60 :if-exists :supersede 61 :if-does-not-exist :create) 62 (format s "(defsystem :foo~D)~%" i)))) 63 64(assert-equal (asdf::parse-output-translations-string 65 (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) 66 '(:output-translations ("/foo" "/bar") :inherit-configuration 67 ("/baz" "/quux"))) 68(assert-equal (asdf::parse-output-translations-string 69 (join-namestrings '("/" ""))) 70 '(:output-translations ("/" nil) :ignore-inherited-configuration)) 71(assert-equal (asdf::parse-output-translations-string 72 (join-namestrings '("/" "" ""))) 73 '(:output-translations ("/" nil) :inherit-configuration)) 74(assert-equal (asdf::parse-output-translations-string 75 (join-namestrings '("/" "/"))) 76 '(:output-translations ("/" "/") :ignore-inherited-configuration)) 77(assert-equal (asdf::parse-output-translations-string 78 "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)") 79 '(:output-translations ("/" "/") :ignore-inherited-configuration)) 80 81(create-asd-files) 82(create-conf-files) 83 84(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/"))) 85(assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/")))) 86 87(format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/"))) 88(assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/")))) 89 90(initialize-source-registry 91 `(:source-registry (:include ,(under-tmp-directory "conf.d/")) 92 (:include ,(under-tmp-directory "dir5/")) 93 (:include ,(under-tmp-directory "dir8/")) 94 (:include ,(under-tmp-directory "dir9/dira/")) 95 :ignore-inherited-configuration)) 96 97(defun dump-source-registry () 98 (format t "~&Source Registry:~%") 99 (loop :for k :being :each hash-key :of *source-registry* 100 :using (hash-value v) 101 :do (format t "~a --> ~a~%" k v))) 102 103(dump-source-registry) 104 105 106(assert (find-system :foo0 nil)) 107(assert (find-system :foo1 nil)) 108(assert (find-system :foo2 nil)) 109(assert (find-system :foo3 nil)) 110(assert (find-system :foo4 nil)) 111(assert (not (find-system :foo5 nil))) 112(assert (find-system :foo6 nil)) 113(assert (find-system :foo7 nil)) 114(assert (find-system :foo8 nil)) 115(assert (not (find-system :foo9 nil))) 116 117(format t "~&A: ~S~%B: ~S~%" 118 (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) 119 (under-tmp-directory "dir2/bar/baz.lisp")) 120(assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp")) 121 (under-tmp-directory "dir2/bar/baz.lisp")) 122 123 124(DBG "Testing link farm found through source registry.") 125(defparameter *link-farm-directory* (under-tmp-directory "link-farm/")) 126 127 128 129(defun link-asd-files () 130 (loop 131 :for d :in *tmp-asd-directories* 132 :for i :from 0 133 :as asd-file = (merge-pathnames* (format nil "foo~D.asd" i) d) 134 :do (assert (probe-file asd-file)) 135 (run-program (format nil "ln -s ~a ~a" (namestring asd-file) (namestring *link-farm-directory*))))) 136 137;;; prepare for link farm test 138;; clean up first 139(describe *link-farm-directory*) 140(when (uiop:directory-exists-p *link-farm-directory*) 141 (uiop:delete-directory-tree *link-farm-directory* 142 :validate (lambda (x) (subpathp x *tmp-directory*)))) 143;; create the link farm 144(ensure-directories-exist *link-farm-directory*) 145(link-asd-files) 146;;; test following symlinks 147(initialize-source-registry 148 `(:source-registry (:include ,(namestring *link-farm-directory*)) 149 :ignore-inherited-configuration)) 150(dump-source-registry) 151 152(assert (find-system :foo0 nil)) 153(assert (find-system :foo1 nil)) 154(assert (find-system :foo2 nil)) 155(assert (find-system :foo3 nil)) 156(assert (find-system :foo4 nil)) 157(assert (not (find-system :foo5 nil))) 158(assert (find-system :foo6 nil)) 159(assert (find-system :foo7 nil)) 160(assert (find-system :foo8 nil)) 161(assert (not (find-system :foo9 nil))) 162