asdf-pathname-test.script 26.2 KB
Newer Older
1
;;; -*- Lisp -*-
2

3
(eval-when (:compile-toplevel :load-toplevel :execute)
4
  #-(or xcl gcl) (push :asdf-test-logical-pathname *features*)
5
6
  #+xcl (push :buggy-untyped-file *features*))

7
8
;;(setf *unspecific-pathname-type* nil)

9
10
;;; test asdf pathname specifications
;;;
11
12
13
14
15
;;; Originally written by James Anderson, refactored by Francois-Rene Rideau
;;;
;;; Creates a test transcript build/results/${implementation}-pathnames.text
;;; The tests construct a simple system/module/source-file system definition and
;;; verify that component pathname specifications refer to lisp source files in the directories
16
17
18
;;;   '/test/{system1,system2}/'
;;; any failure is recorded as a transcript entry which indicates
;;;   ( ( system-pathname module-pathname file-pathname ) missing-pathnames )
19
20
;;; where missing pathnames is a list of the component-pathname values
;;; which failed to designate an intended file.
21
;;; If there, if the pathname is logical, both the logical and physical pathname appears.
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
;;; where NIL appears, the probe-file succeeded.
;;;
;;; the test creates the logical host "ASDFTEST" and the system "test-system".
;;; both are removed at the conclusion.
;;;
;;; 20100314:
;;; (:module "a/b/c.d") => (make-pathname :directory '(:relative "a" "b" "c.d"))
;;; (:file "a/b/c.d") => (make-pathname :directory '(:relative "a" "b") :name "c.d" :type "lisp"))
;;; (:static-file "a/b/c.d") => (make-pathname :directory '(:relative "a" "b") :name "c" :type "d"))
;;; (:module "/a/b/c.d") => (make-pathname :directory '(:absolute "a" "b" "c.d"))
;;; (:file "/a/b/c.d") => (make-pathname :directory '(:absolute "a" "b") :name "c.d" :type "lisp"))
;;; (:static-file "/a/b/c.d") => (make-pathname :directory '(:absolute "a" "b") :name "c" :type "d"))
;;;
;;; (:file "file2.lisp") means #p"file2.lisp.lisp"
;;; (:static-file "file2.lisp") means #p"file2.lisp"
;;; (:file "module1-1/file3.lisp") means #p"module1-1/file3.lisp.lisp" (assuming /)
;;; (:static-file "module1-1/file3.lisp") means #p"module1-1/file3.lisp"

40
(defun setup-asdftest-logical-host (&key (root *build-directory*) (bin-type (compile-file-type)))
41
42
  (declare (ignorable root bin-type))
  #+asdf-test-logical-pathname
43
44
45
46
47
48
49
50
51
52
53
54
55
56
  (setf (logical-pathname-translations "ASDFTEST")
        `((,(format nil "**;*.~a" bin-type)
           ,(subpathname root (make-pathname :directory '(:relative :wild-inferiors)
                                             :name :wild :type bin-type :version nil)))
          (,(format nil "**;*.~a.*" bin-type)
           ,(subpathname root (make-pathname :directory '(:relative "asdf-bin" :wild-inferiors)
                                             :name :wild :type bin-type
                                             :defaults root)))
          ("**;*.*"
           ,(subpathname root (make-pathname :directory '(:relative "asdf-src" :wild-inferiors)
                                             :name :wild :type :wild :version nil)))
          ("**;*.*.*"
           ,(subpathname root (make-pathname :directory '(:relative "asdf-src" :wild-inferiors)
                                             :name :wild :type :wild))))))
57

58
59
60
61
62
63
64
(defclass test-status ()
  ((system-count :initform 0)
   (directory-count :initform 0)
   (file-count :initform 0)
   (system-failures :initform 0)
   (directory-failures :initform 0)
   (file-failures :initform 0)
65
   (all-tests :initform ())))
66

67
(defparameter *test-status* (make-instance 'test-status))
68

69
70
71
72
73
74
75
76
77
78
79
(defun pathname-defsystem (&key system-pathname module-pathname file-pathname
                             (support-absolute-string-pathnames t)
                             (root-directory-namestring (namestring *build-directory*)))
  `(defsystem :test-system
     :pathname ,system-pathname
     :source-file ,(subpathname system-pathname "nosuchfile.asd")
     :components
     ((:module :module1 :pathname ,module-pathname
       :components
       ((:file "file" :pathname ,file-pathname)
        (:file "module2/file" :pathname ,file-pathname)
80
81
        ,@(unless (or (logical-pathname-p system-pathname)
                      (logical-pathname-p module-pathname))
82
83
84
85
86
87
88
            `((:file "typed-file.type" :pathname ,file-pathname)
              (:static-file "static-file.type" :pathname ,file-pathname)
              (:file "module2/typed-file.type" :pathname ,file-pathname)
              (:static-file "module2/static-file.type" :pathname ,file-pathname)
              ,@(when support-absolute-string-pathnames
                  `((:static-file ,(strcat root-directory-namestring "asdf-src/system1/module1/file.lisp")
                     :pathname ,file-pathname))))))))))
89

90
(defun translate-if-needed (pathname)
91
  (if (logical-pathname-p pathname)
92
93
94
95
96
      (cons (translate-logical-pathname pathname) pathname)
      pathname))

(defun test-module (module &key configuration (test-status *test-status*))
  (with-slots (system-count directory-count file-count
97
               system-failures directory-failures file-failures all-tests) test-status
98
    (incf directory-count)
99
100
101
102
103
104
105
106
107
108
    (let ((success (and (probe-file* (component-pathname module)) t)))
      (unless success
        (incf directory-failures))
      (push (list success (type-of module) (component-find-path module)
                  (translate-if-needed (component-pathname module))
                  configuration
                  (list (if-let (parent (component-parent module))
                                (component-pathname parent))))
            all-tests)
      success)))
109

110
(defparameter *backtraces* 0)
111
(defparameter *max-backtraces* 10)
112

113
114
(defun test-file (file &key configuration (test-status *test-status*) (start-time 0))
  (with-slots (system-count directory-count file-count
115
116
               system-failures directory-failures file-failures all-tests) test-status
    (let ((success
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
117
            (block :foo ;; XCL 0.0.0.291 is confused if using block nil
118
119
              (handler-bind ((error #'(lambda (c)
                                        (incf *backtraces*)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
120
                                        (dolist (o (list *trace-output* *standard-output*))
121
                                          (when (<= *backtraces* *max-backtraces*)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
122
                                            (print-condition-backtrace c :stream o)))
123
124
125
                                        (return-from :foo nil))))
                (assert (probe-file* (component-pathname file)) ()
                        "Can't find pathname ~S for component ~S" (component-pathname file) file)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
126
                (with-open-file (stream (component-pathname file)
127
128
                                        :direction :output :if-exists
                                        (or #+(and sbcl os-windows) :rename-and-delete :supersede)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
129
                                        :if-does-not-exist :error)
130
131
132
133
134
135
136
                  (assert stream)
                  (println start-time stream)))
              t)))
      (incf file-count)
      (unless success
        (incf file-failures))
      (push (list success (type-of file) (component-find-path file)
137
138
139
140
                  (translate-if-needed (component-pathname file))
                  configuration
                  (list (component-pathname (component-system file))
                        (component-pathname (component-parent file))))
141
            all-tests))))
142

143
144
145
146
147
148
(defun test-pathname-configuration (&key system-pathname module-pathname file-pathname
                                      (start-time (get-universal-time))
                                      (test-status *test-status*)
                                      (support-absolute-string-pathnames t)
                                      (root-directory-namestring (namestring *build-directory*))
                                      (result-stream *standard-output*))
149
  (with-slots (system-count directory-count file-count system-failures) test-status
150
151
152
153
154
155
156
157
158
159
    (let ((configuration (list system-pathname module-pathname file-pathname))
          (system-definition (pathname-defsystem
                              :system-pathname system-pathname
                              :module-pathname module-pathname
                              :file-pathname file-pathname
                              :support-absolute-string-pathnames support-absolute-string-pathnames
                              :root-directory-namestring root-directory-namestring)))
      (handler-bind
          ((error (lambda (c)
                    (incf system-failures)
160
161
162
                    (dolist (o (list *trace-output* result-stream))
                      (format o "~&error during sysdef:~% ~S~%" system-definition)
                      (print-condition-backtrace c :stream o))
163
                    (return-from test-pathname-configuration test-status))))
164
165
        (unless (and (or (logical-pathname-p system-pathname)
                         (logical-pathname-p module-pathname))
166
167
168
169
170
171
172
173
174
175
176
177
178
                     (and (stringp file-pathname) (find #\. file-pathname)))
          (incf system-count)
          (with-asdf-cache (:override t)
            (clear-system :test-system)
            (let* ((system (let ((*verbose-out* nil))
                             (eval system-definition)))
                   (module (first (component-children system)))
                   (file-components (component-children module)))
              (test-module system :test-status test-status :configuration configuration)
              (test-module module :test-status test-status :configuration configuration)
              (dolist (file file-components)
                (test-file file :test-status test-status :configuration configuration :start-time start-time))))))))
  test-status)
179

180
181
182
(defun print-test-report (&key (test-status *test-status*) (result-stream *standard-output*)
                            (start-time 0) test-files files modules systems)
  (with-slots (system-count directory-count file-count
183
               system-failures directory-failures file-failures all-tests) test-status
184
185
186
187
188
189
190
191
192
    (format result-stream "~% target files [~s]~:{~% ~s -> ~s~}~%"
            (length test-files)
            (mapcar #'(lambda (file)
                        (list file (if (probe-file file)
                                       (if (> (file-write-date file) start-time)
                                           :ok
                                           :untouched)
                                       :missing)))
                    test-files))
193
    #+asdf-test-logical-pathname
194
195
196
    (format result-stream "~&~%~% translations: ~a: ~s" "ASDFTEST" (logical-pathname-translations "ASDFTEST"))
    (format result-stream "~&~%~% variations:~% systems: ~s~% modules: ~s~% files: ~s"
            systems modules files)
197

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    (let ((homogeneous-failures 0)
          (failures (+ system-failures directory-failures file-failures))
          (*print-length* nil))
      (format result-stream "~&~%~% pathname failures [~s]:" failures)
      (dolist (tst (and (plusp failures) all-tests))
        (destructuring-bind (success type name intended-pathname configuration parent-pathnames) tst
          (format result-stream "~&~%~:[FAILURE~;SUCCESS~] ~:[ ~;!~]~a~24T~s~%  ~:[missing:  ~;found:  ~]~24T~s~%  configuration:~24T~s~%  parent pathnames:~24T~s"
                  success
                  (let ((homogeneousp
                          (let ((f (first configuration)))
                            (assert f)
                            (let ((logicalp (logical-pathname-p f)))
                              (loop for p in (rest configuration)
                                    always (or (null p) (eq logicalp (logical-pathname-p p))))))))
                    (when (and (not success) homogeneousp)
                      (incf homogeneous-failures))
                    homogeneousp)
                  type name success intended-pathname configuration parent-pathnames)))
216
217
218
219
220
221
222
223
224
225
226
      (terpri result-stream)
      (print (print `(:result :type ,(lisp-implementation-type) :version ,(lisp-implementation-version)
                              :file ,(pathname result-stream)
                              :system-failures (,system-failures ,system-count)
                              :directory-failures (,directory-failures ,directory-count)
                              :file-failures (,file-failures ,file-count)
                              :homogeneous ,homogeneous-failures)
                    result-stream)
             *trace-output*)
      (terpri *trace-output*)
      (force-output *trace-output*)
227
      (zerop failures))))
228

229
230
231
232
233
(defun make-test-files (&key (root *build-directory*) (support-string-pathnames t)
                          (support-absolute-string-pathnames t)
                          (root-directory-namestring (namestring root)))
  (let ((systems
          `(,(subpathname root "asdf-src/system1/")
234
            #+asdf-test-logical-pathname
235
            ,@`(,(make-pathname :host "ASDFTEST" :directory '(:absolute "system1"))
236
                ,(parse-namestring "ASDFTEST:system1;"))
237
238
239
240
241
242
243
244
            ,@(when support-string-pathnames
                `(,(format nil "~{/~a~}/asdf-src/system1" (rest (pathname-directory root)))))))
        (modules
          `(nil
            ,(make-pathname :directory '(:relative) :name nil :type nil)
            ,(make-pathname :directory '(:relative "module2") :name nil :type nil)
            ,(make-pathname :directory '(:relative "module2" "module3") :name nil :type nil)
            ,(subpathname root "asdf-src/system2/module4/")
245
            #+asdf-test-logical-pathname
246
            ,@`(,(make-pathname :host "ASDFTEST" :directory '(:absolute "system2" "module4")
247
248
                                :name nil :type nil)
                ,(parse-namestring "ASDFTEST:system2;module4;"))
249
250
251
252
253
254
255
256
257
258
259
260
261
262
            ,@(when support-string-pathnames
                `(""
                  "module2"
                  "module2/"
                  "module2/module3"
                  "module2/module3/"
                  ,@(when support-absolute-string-pathnames
                      `(,(strcat root-directory-namestring "asdf-src/system1/module1")
                        ,(strcat root-directory-namestring "asdf-src/system1/module1/")
                        ,(strcat root-directory-namestring "asdf-src/system1/module2/")
                        ,(strcat root-directory-namestring "asdf-src/system1/module2/module3/")
                        ,(strcat root-directory-namestring "asdf-src/system2/module4/")))))))
        (files
          `(nil
263
264
            #-buggy-untyped-file ,(parse-unix-namestring "./untyped-file")
            #-buggy-untyped-file ,(parse-unix-namestring "file")
265
266
            ,(parse-unix-namestring "./file.lisp")
            ,(parse-unix-namestring "typed-file.type")
267
            #-buggy-untyped-file ,(parse-unix-namestring "module2/untyped-file")
268
269
            ,(parse-unix-namestring "module2/file.lisp")
            ,(parse-unix-namestring "module2/module3/file.lisp")
270
            #-buggy-untyped-file ,(subpathname root "asdf-src/system1/module1/untyped-file")
271
            ,(subpathname root "asdf-src/system1/module1/file.lisp")
272
            #-buggy-untyped-file ,(subpathname root "asdf-src/system1/module2/untyped-file")
273
274
275
            ,(subpathname root "asdf-src/system1/module2/file.lisp")
            ,(subpathname root "asdf-src/system1/module2/module3/file.lisp")
            ,(subpathname root "asdf-src/system2/module4/file.lisp")
276
            #+asdf-test-logical-pathname
277
            ,@`(,(make-pathname :host "ASDFTEST" :device nil
278
279
280
                                :directory '(:absolute "system2" "module4")
                                :name "file" :type "lisp" :version nil)
                ,(parse-namestring "ASDFTEST:system2;module4;file.lisp"))
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
            ,@(when support-string-pathnames
                `(,(strcat root-directory-namestring "asdf-src/system1/module1/file.lisp")))))
        (test-files
          (remove-duplicates
           (sort (loop
                   ;; enumerate (system x module x file) pathname variations for relative
                   ;; file component names. no additions for the absolute specifications,
                   ;; as they should reiterate one of the relative names
                   for directory in
                                 (flet ((src-dir (&rest path)
                                          (append (or (pathname-directory root) (list :relative))
                                                  (cons "asdf-src" path))))
                                   (list (src-dir "system1")
                                         (src-dir "system1" "module1")
                                         (src-dir "system1" "module2")
                                         (src-dir "system1" "module2" "module3")
                                         (src-dir "system2" "module4")))
                   ;; :pathname #p"untyped-file"
299
                   #-buggy-untyped-file #-buggy-untyped-file
300
301
302
303
304
                   collect (make-pathname :directory directory :name "untyped-file" :type nil
                                          :defaults root)
                   ;; :file "file"
                   collect (make-pathname :directory directory :name "file" :type "lisp"
                                          :defaults root)     ; for source files
305
                   #-buggy-untyped-file #-buggy-untyped-file
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
                   collect (make-pathname :directory directory :name "file" :type nil
                                          :defaults root)        ; for static files
                                                                 ;; :file "typed-file.type"
                   collect (make-pathname :directory directory :name "typed-file.type" :type "lisp"
                                          :defaults root)  ; for source files
                   collect (make-pathname :directory directory :name "typed-file" :type "type"
                                          :defaults root)       ; for static files for :pathname arg
                                                                ;; :static-file "static-file.type"
                   collect (make-pathname :directory directory :name "static-file" :type "type"
                                          :defaults root)
                   ;; :file "module2/file"
                   collect (make-pathname :directory directory :name "file" :type "lisp"
                                          :defaults root)
                   ;; :file "module2/typed-file.type"
                   collect (make-pathname :directory directory :name "typed-file.type" :type "lisp"
                                          :defaults root)          ; for source files
322
323
                   ;; collect (make-pathname :directory directory :name "typed-file.type" :type nil)          ; for static files ;; invalid as static file, unlike the below.
                   ;; :static-file "module2/static-file.type"
324
325
                   collect (make-pathname :directory directory :name "static-file" :type "type"
                                          :defaults root)
326

327
                                     ;;; source file pathname variations
328
                   #-buggy-untyped-file #-buggy-untyped-file
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
                   collect (make-pathname :directory (append directory '("module2")) :name  "untyped-file" :type nil
                                          :defaults root)
                   collect (make-pathname :directory (append directory '("module2")) :name  "file" :type "lisp"
                                          :defaults root)
                   collect (make-pathname :directory (append directory '("module2")) :name  "typed-file.type" :type "lisp"
                                          :defaults root)
                   collect (make-pathname :directory (append directory '("module2")) :name  "static-file" :type "type"
                                          :defaults root)
                   collect (make-pathname :directory (append directory '("module2" "module3")) :name  "file" :type "lisp"
                                          :defaults root)
                   collect (make-pathname :directory (append directory '("module2" "module3")) :name  "file" :type "lisp"
                                          :defaults root))
                 #'string-lessp
                 ;; generate an alternative key in case namestring fails on a name w/ a dot
                 :key #'(lambda (p) (format nil "~{~a~^.~}~@[.~a~]~@[.~a~]" (rest (pathname-directory p)) (pathname-name p) (pathname-type p))))
           :test #'equalp :from-end t)))
    (values systems modules files test-files)))
346

347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
(defun test-component-pathnames (&key (root *build-directory*)
                                   (delete-host t)
                                   (support-string-pathnames nil)
                                   (support-absolute-string-pathnames nil))
  (unwind-protect
       (let ((root-directory-namestring (format nil "~{/~a~}/" (rest (pathname-directory root))))
             (test-status (setf *test-status* (make-instance 'test-status)))
             (*print-pretty* nil)
             (start-time 0))
         (with-slots (system-count directory-count file-count
                      system-failures directory-failures file-failures failures) test-status
           (with-open-file (result-stream (subpathname
                                           *build-directory*
                                           (format nil "results/~(~A~)-pathnames.text" *implementation*))
                                          :direction :output
                                          :if-exists :supersede :if-does-not-exist :create)
             (setup-asdftest-logical-host :root root)
364
             #+(and asdf-test-logical-pathname (not clisp))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
365
366
367
368
             (assert-pathname-equal
              (make-pathname :host "ASDFTEST" :directory '(:absolute "system2" "module4")
                             :name nil :type nil)
              (parse-namestring "ASDFTEST:system2;module4;"))
369
370
371
372
373
374
375
376
377
             (multiple-value-bind (systems modules files test-files)
                 (make-test-files
                  :root root
                  :support-string-pathnames support-string-pathnames
                  :support-absolute-string-pathnames support-absolute-string-pathnames
                  :root-directory-namestring root-directory-namestring)
               (dolist (file test-files)
                 (ensure-directories-exist file)
                 (with-open-file (stream file :direction :output :if-exists :supersede :if-does-not-exist :create)
378
379
                   ;;(format t "Created test file ~S~%" file)
                   (println ":dummy-content" stream)))
380
381
382
383
384
385
386
387
388
389
               (multiple-value-bind (second minute hour day month year)
                   (decode-universal-time (setf start-time (get-universal-time)) 0)
                 (let ((header (format nil "~4,'0d~2,'0d~2,'0dT~2,'0d~2,'0d~2,'0dZ : ~a ~a ~a"
                                       year month day hour minute second
                                       (lisp-implementation-type)
                                       (lisp-implementation-version)
                                       (asdf-version))))
                   (format result-stream ";;; ~a~%~%" header)
                   (format *trace-output* "~%;;; ~a~%~%" header)))
               (sleep 1)
390

391
392
393
394
395
396
397
398
399
400
401
402
               (dolist (system-pathname systems)
                 (dolist (module-pathname modules)
                   (dolist (file-pathname files)
                     (test-pathname-configuration
                      :system-pathname system-pathname
                      :module-pathname module-pathname
                      :file-pathname file-pathname
                      :start-time start-time
                      :support-absolute-string-pathnames support-absolute-string-pathnames
                      :root-directory-namestring root-directory-namestring
                      :result-stream result-stream
                      :test-status test-status))))
403

404
405
406
407
408
409
410
411
               (print-test-report
                :test-status test-status
                :result-stream result-stream
                :start-time start-time
                :test-files test-files
                :files files
                :modules modules
                :systems systems)))))
412

413
414
415
416
    #+asdf-test-logical-pathname
    (when delete-host
      (setf (logical-pathname-translations "ASDFTEST") nil))
    (clear-system "test-system")))
417

418
(defun test-pathname-parsing ()
419
  #-(or allegro clisp clozure cmu ecl lispworks mkcl sbcl)
420
  (DBG "Can't test pathname parsing: this lisp lacks SETENV support.")
421
  #+(or allegro clisp clozure cmu ecl lispworks mkcl sbcl)
422
423
424
425
426
427
428
  (let ((old-config (uiop:getenvp "XDG_CONFIG_DIRS"))
        (old-home-config (uiop:getenvp "XDG_CONFIG_HOME")))
    (unwind-protect
         (progn
           (setf (uiop:getenv "XDG_CONFIG_DIRS") "/foo:prismatic")
           (multiple-value-bind (ret err)
               (ignore-errors
429
                (uiop:xdg-config-pathnames))
430
431
432
433
434
             (assert (and (not ret) err)))
           (setf (uiop:getenv "XDG_CONFIG_DIRS") "/foo:")
           (setf (uiop:getenv "XDG_CONFIG_HOME") "")
           (multiple-value-bind (ret err)
               (ignore-errors
435
                (uiop:xdg-config-pathnames))
436
437
438
439
440
441
442
             (assert (not err))
             (assert (= (length ret) 2))))
      (when old-config
        (setf (uiop:getenv "XDG_CONFIG_DIRS") old-config))
      (when old-home-config
        (setf (uiop:getenv "XDG_CONFIG_HOME") old-home-config)))))

443
444
445
446
(asdf:initialize-source-registry)
(format t "source registry: ~S~%" (hash-table->alist asdf::*source-registry*))
(asdf:initialize-output-translations)
(format t "output translations: ~S~%" (asdf::output-translations))
Francois-Rene Rideau's avatar
1.647:    
Francois-Rene Rideau committed
447

448
;; we're testing with unix or some emulation, are we not?
449

450
(assert-pathname-equal (resolve-location '(:home)) (truename (user-homedir-pathname)))
451
452
453
454
455
456
457
#-os-windows
(progn
  (assert-pathname-equal (resolve-location '("/foo" "bar" "baz")) #p"/foo/bar/baz")
  (assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory t) #p"/foo/bar/baz/")
  (assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory t :wilden t) (wilden #p"/foo/bar/baz/"))
  (assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory nil :wilden t) (wilden #p"/foo/bar/"))
  (assert-pathname-equal (resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :ensure-directory nil :wilden t) #p"/foo/bar/**/baz/*.*"))
458

459
460
461
(assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-1))))
(assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-2))))

462
#-gcl ;; expected-failure: GCL crashes badly
463
(assert (test-component-pathnames :delete-host t :support-string-pathnames nil))
464

465
#+os-unix
466
(test-pathname-parsing)