test-logical-pathname.script 1.79 KB
Newer Older
1
2
3
4
;;; -*- Lisp -*-
(load "script-support.lisp")
(load-asdf)

5
#-gcl<2.7
6
(setf (logical-pathname-translations "ASDF")
7
8
9
10
11
      #+(or allegro clisp)
      `(("**;*.*.*" ,(asdf::wilden *asdf-directory*)))
      #-(or allegro clisp)
      `(("**;*.asd.*" ,(make-pathname :type "asd" :defaults (asdf::wilden *asdf-directory*)))
        ("**;*.lisp.*" ,(make-pathname :type "lisp" :defaults (asdf::wilden *asdf-directory*)))
12
        ("**;*.*.*" ,(resolve-location
13
14
                      `(,*asdf-directory* "tmp/fasls" :implementation "logical-host-asdf")
                      :wilden t))))
15
16
17
18
19

(quit-on-error
 (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd"))
 (format t "~S~%" (truename "ASDF:test;test-force.asd"))

20
 #-(or xcl gcl<2.7)
21
22
23
24
 (progn
   (format t "Test logical pathnames in central registry~%")
   (setf *central-registry* '(#p"ASDF:test;"))
   (initialize-source-registry '(:source-registry :ignore-inherited-configuration))
25
   (load-system :test-logical-pathname :force t))
26

27
 #-(or xcl gcl<2.7)
28
29
 (progn
   (format t "Test logical pathnames in source-registry, non-recursive~%")
30
   (clear-system :test-logical-pathname)
31
32
33
   (setf *central-registry* '())
   (initialize-source-registry
    '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
34
   (load-system :test-logical-pathname :force t))
35

36
 #-(or xcl gcl<2.7)
37
38
 (progn
   (format t "Test logical pathnames in source-registry, recursive~%")
39
   (clear-system :test-logical-pathname)
40
41
42
   (setf *central-registry* '())
   (initialize-source-registry
    ;; Bug: Allegro Express 8.2 incorrectly reads #p"ASDF:" as relative.
43
    '(:source-registry (:tree #-allegro #p"ASDF:" #+allegro #.(asdf::pathname-root #p"ASDF:"))
44
      :ignore-inherited-configuration))
45
   (load-system :test-logical-pathname :force t))
46
47

 (format t "Done~%"))