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

5 6 7
(in-package :asdf)
(use-package :asdf-test)

8
(with-test ()
9 10 11 12

(assert
 (every #'directory-pathname-p
  (list
13 14 15
   (make-pathname* :name nil :type "" :directory '(:absolute "tmp"))
   (make-pathname* :name "" :directory '(:absolute "tmp"))
   (make-pathname* :type "" :directory '(:absolute "tmp"))
16 17
;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here,
;; and some implementations will enforce it.
18 19 20
   (make-pathname* :type *unspecific-pathname-type* :directory '(:absolute "tmp"))
   (make-pathname* :name *unspecific-pathname-type* :directory '(:absolute "tmp"))
   (make-pathname* :name *unspecific-pathname-type* :directory '(:absolute "tmp")))))
21 22 23
(assert
 (every (complement #'directory-pathname-p)
  (list
24 25
   (make-pathname* :name "foo" :type nil :directory '(:absolute "tmp"))
   (make-pathname* :name nil :type "bar" :directory '(:absolute "tmp")))))
26
;; These are funky and non portable, omit from tests:
27 28
;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp"))
;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp"))
29
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "" :want-directory t))
30
               '(:relative nil nil nil)))
31
(assert (equal (multiple-value-list (split-unix-namestring-directory-components ""  :want-directory nil))
32
               '(:relative nil nil nil)))
33
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/" :want-directory t))
34
               '(:absolute nil nil nil)))
35
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/" :want-directory nil))
36
               '(:absolute nil nil nil)))
37
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/aa/ba" :want-directory t))
38
               '(:absolute ("aa" "ba") nil nil)))
39
(assert (equal (multiple-value-list (split-unix-namestring-directory-components "/aa/ba" :want-directory nil))
40
               '(:absolute ("aa") "ba" nil)))
41
(assert
42
 (version-satisfies (asdf-version) (asdf-version)))
43
(assert
44
 (version-satisfies (asdf-version) "2.000"))
45
(assert
46
 (not (version-satisfies (asdf-version) "666")))
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
(assert-equal
 (mapcar 'namestring (split-native-pathnames-string "foo:bar"))
 '("foo" "bar"))
(assert-equal
 (mapcar 'namestring (split-native-pathnames-string "foo:bar" :want-directory t))
 '("foo/" "bar/"))
(assert-equal
 (mapcar 'namestring (split-native-pathnames-string "/foo:/bar" :want-absolute t))
 '("/foo" "/bar"))
(assert-equal
 (mapcar 'namestring (split-native-pathnames-string "/foo:/bar" :want-absolute t :want-directory t))
 '("/foo/" "/bar/"))
(assert-equal
 (mapcar 'location-function-p
         '((:function f)
           (:function (lambda (path absolute-source)
                        (declare (ignore absolute-source))
                        path))
           (function previous-isnt-keyword)
           (:function f too many arguments)
           (:function (:lambda isnt lambda))
           (:function (lambda (too many args) blah))))
 '(t t nil nil nil nil)))