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

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
5 6 7
#+clisp
(trace load compile-file)

8
#-gcl<2.7
9
(setf (logical-pathname-translations "ASDF")
10 11 12 13 14
      #+(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*)))
15
        ("**;*.*.*" ,(resolve-location
16
                      `(,*asdf-directory* "build/fasls" :implementation "logical-host-asdf")
17
                      :wilden t))))
18

19
(with-test ()
20 21 22 23 24
  #-gcl<2.7
  (DBG :logical
       (logical-pathname-translations "ASDF")
       (translate-logical-pathname "ASDF:test;test-force.asd")
       (truename "ASDF:test;test-force.asd"))
25

26 27 28 29 30 31
  #-(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)))
32

33 34 35 36 37 38 39 40
  #-(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))
41

42 43 44 45 46 47 48 49 50 51 52
  #-(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))
53 54
    (load-system :test-logical-pathname :force t)
    (let ((sys (find-system :test-logical-pathname)))
55 56
      #-clisp (assert (logical-pathname-p (component-pathname sys)))
      #-clisp (assert (logical-pathname-p (system-source-file sys)))))
57

58
  (DBG "Done"))