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