truename.lsp 2.79 KB
Newer Older
1
2
3
4
5
6
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jan  6 05:32:37 2004
;;;; Contains: Tests of TRUENAME

(deftest truename.1
7
  (let* ((pn #p"truename.txt")
sds's avatar
sds committed
8
         (tn (truename pn)))
9
10
11
12
13
14
15
16
17
    (values
     (notnot (pathnamep pn))
     (typep pn 'logical-pathname)
     (equalt (pathname-name pn) (pathname-name tn))
     (equalt (pathname-type pn) (pathname-type tn))
     ))
  t nil t t)

(deftest truename.2
18
  (let* ((name "truename.txt")
sds's avatar
sds committed
19
20
         (pn (pathname name))
         (tn (truename name)))
21
22
23
24
25
26
27
28
29
    (values
     (notnot (pathnamep pn))
     (typep pn 'logical-pathname)
     (equalt (pathname-name pn) (pathname-name tn))
     (equalt (pathname-type pn) (pathname-type tn))
     ))
  t nil t t)

(deftest truename.3
30
  (let* ((pn #p"truename.txt"))
31
32
33
34
    (with-open-file
     (s pn :direction :input)
     (let ((tn (truename s)))
       (values
sds's avatar
sds committed
35
36
37
38
39
        (notnot (pathnamep pn))
        (typep pn 'logical-pathname)
        (equalt (pathname-name pn) (pathname-name tn))
        (equalt (pathname-type pn) (pathname-type tn))
        ))))
40
41
42
  t nil t t)

(deftest truename.4
43
  (let* ((pn #p"truename.txt"))
44
45
46
    (let ((s (open pn :direction :input)))
      (close s)
      (let ((tn (truename s)))
sds's avatar
sds committed
47
48
49
50
51
52
        (values
         (notnot (pathnamep pn))
         (typep pn 'logical-pathname)
         (equalt (pathname-name pn) (pathname-name tn))
         (equalt (pathname-type pn) (pathname-type tn))
         ))))
53
54
  t nil t t)

55
(deftest truename.5
56
  (let* ((lpn "CLTEST:foo.txt")
sds's avatar
sds committed
57
         (pn (translate-logical-pathname lpn)))
58
59
60
61
62
63
    (unless (probe-file lpn)
      (with-open-file (s lpn :direction :output) (format s "Stuff~%")))
    (let ((tn (truename lpn)))
      (values
       (notnot (pathnamep pn))
       (if (equalt (pathname-name pn) (pathname-name tn))
sds's avatar
sds committed
64
           t (list (pathname-name pn) (pathname-name tn)))
65
       (if (equalt (pathname-type pn) (pathname-type tn))
sds's avatar
sds committed
66
           t (list (pathname-type pn) (pathname-type tn)))
67
68
69
       )))
  t t t)

70
71
72
73
;;; Specialized string tests

(deftest truename.6
  (do-special-strings
74
75
   (s "truename.txt" nil)
   (assert (equalp (truename s) (truename "truename.txt"))))
76
77
78
  nil)

;;; Error tests
79
80

(deftest truename.error.1
81
82
  (signals-error (truename) program-error)
  t)
83
84

(deftest truename.error.2
85
  (signals-error (truename "truename.txt" nil) program-error)
86
  t)
87
88

(deftest truename.error.3
89
  (signals-error-always (truename "nonexistent") file-error)
90
  t t)
91
92

(deftest truename.error.4
93
  (signals-error-always (truename #p"nonexistent") file-error)
94
  t t)
95
96

(deftest truename.error.5
97
98
    (signals-error-always
     (truename
99
      (logical-pathname "CLTESTROOT:nonexistent"))
100
  file-error) t t)
101
102

(deftest truename.error.6
103
  (signals-error-always
104
   (let ((pn (make-pathname :name :wild
sds's avatar
sds committed
105
                            :defaults *default-pathname-defaults*)))
106
107
108
     (truename pn))
   file-error)
  t t)