test-logical-pathname.script 2.1 KB
Newer Older
1
;;; -*- Lisp -*-
2

3 4
(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
                      `(,*asdf-directory* "build/fasls" :implementation "logical-host-asdf")
14
                      :wilden t))))
15

16
(progn
17 18 19 20 21
  #-gcl<2.7
  (DBG :logical
       (logical-pathname-translations "ASDF")
       (translate-logical-pathname "ASDF:test;test-force.asd")
       (truename "ASDF:test;test-force.asd"))
22

23 24 25 26 27 28
  #-(or xcl gcl<2.7)
  (progn
    (DBG "Test logical pathnames in central registry")
    (setf *central-registry* '(#p"ASDF:test;"))
    (initialize-source-registry '(:source-registry :ignore-inherited-configuration))
    (DBG "loading" (oos 'load-op :test-logical-pathname :force t)))
29

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

39 40 41 42 43 44 45 46 47 48 49
  #-(or xcl gcl<2.7)
  (progn
    (DBG "Test logical pathnames in source-registry, recursive")
    (clear-system :test-logical-pathname)
    (setf *central-registry* '())
    (initialize-source-registry
     ;; Bug: Allegro Express 8.2 and 9.0 incorrectly read #p"ASDF:" as relative.
     ;; other bug: around 2.26.xx, CLISP borks badly if this is ASDF:
     ;; and it tries to load ASDF from a logical-pathname.
     '(:source-registry (:tree #p"ASDF:test;")
       :ignore-inherited-configuration))
50 51
    (load-system :test-logical-pathname :force t)
    (let ((sys (find-system :test-logical-pathname)))
52 53
      #-clisp (assert (logical-pathname-p (component-pathname sys)))
      #-clisp (assert (logical-pathname-p (system-source-file sys)))))
54

55
  (DBG "Done"))