source: trunk/source/tests/ansi-tests/truename.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Jan  6 05:32:37 2004
4;;;; Contains: Tests of TRUENAME
5
6(in-package :cl-test)
7
8(deftest truename.1
9  (let* ((pn #p"truename.lsp")
10         (tn (truename pn)))
11    (values
12     (notnot (pathnamep pn))
13     (typep pn 'logical-pathname)
14     (equalt (pathname-name pn) (pathname-name tn))
15     (equalt (pathname-type pn) (pathname-type tn))
16     ))
17  t nil t t)
18
19(deftest truename.2
20  (let* ((name "truename.lsp")
21         (pn (pathname name))
22         (tn (truename name)))
23    (values
24     (notnot (pathnamep pn))
25     (typep pn 'logical-pathname)
26     (equalt (pathname-name pn) (pathname-name tn))
27     (equalt (pathname-type pn) (pathname-type tn))
28     ))
29  t nil t t)
30
31(deftest truename.3
32  (let* ((pn #p"truename.lsp"))
33    (with-open-file
34     (s pn :direction :input)
35     (let ((tn (truename s)))
36       (values
37        (notnot (pathnamep pn))
38        (typep pn 'logical-pathname)
39        (equalt (pathname-name pn) (pathname-name tn))
40        (equalt (pathname-type pn) (pathname-type tn))
41        ))))
42  t nil t t)
43
44(deftest truename.4
45  (let* ((pn #p"truename.lsp"))
46    (let ((s (open pn :direction :input)))
47      (close s)
48      (let ((tn (truename s)))
49        (values
50         (notnot (pathnamep pn))
51         (typep pn 'logical-pathname)
52         (equalt (pathname-name pn) (pathname-name tn))
53         (equalt (pathname-type pn) (pathname-type tn))
54         ))))
55  t nil t t)
56
57(deftest truename.5
58  (let* ((lpn "CLTEST:foo.txt")
59         (pn (translate-logical-pathname lpn)))
60    (unless (probe-file lpn)
61      (with-open-file (s lpn :direction :output) (format s "Stuff~%")))
62    (let ((tn (truename lpn)))
63      (values
64       (notnot (pathnamep pn))
65       (if (equalt (pathname-name pn) (pathname-name tn))
66           t (list (pathname-name pn) (pathname-name tn)))
67       (if (equalt (pathname-type pn) (pathname-type tn))
68           t (list (pathname-type pn) (pathname-type tn)))
69       )))
70  t t t)
71
72;;; Specialized string tests
73
74(deftest truename.6
75  (do-special-strings
76   (s "truename.lsp" nil)
77   (assert (equalp (truename s) (truename "truename.lsp"))))
78  nil)
79
80;;; Error tests
81
82(deftest truename.error.1
83  (signals-error (truename) program-error)
84  t)
85
86(deftest truename.error.2
87  (signals-error (truename "truename.lsp" nil) program-error)
88  t)
89
90(deftest truename.error.3
91  (signals-error-always (truename "nonexistent") file-error)
92  t t)
93
94(deftest truename.error.4
95  (signals-error-always (truename #p"nonexistent") file-error)
96  t t)
97
98(deftest truename.error.5
99  (signals-error-always (truename (logical-pathname "CLTESTROOT:nonexistent")) file-error)
100  t t)
101
102(deftest truename.error.6
103  (signals-error-always
104   (let ((pn (make-pathname :name :wild
105                            :defaults *default-pathname-defaults*)))
106     (truename pn))
107   file-error)
108  t t)
Note: See TracBrowser for help on using the repository browser.