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

(in-package :cl-test)

(deftest truename.1
  (let* ((pn #p"truename.lsp")
sds's avatar
sds committed
10
         (tn (truename pn)))
11 12 13 14 15 16 17 18 19 20
    (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
  (let* ((name "truename.lsp")
sds's avatar
sds committed
21 22
         (pn (pathname name))
         (tn (truename name)))
23 24 25 26 27 28 29 30 31 32 33 34 35 36
    (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
  (let* ((pn #p"truename.lsp"))
    (with-open-file
     (s pn :direction :input)
     (let ((tn (truename s)))
       (values
sds's avatar
sds committed
37 38 39 40 41
        (notnot (pathnamep pn))
        (typep pn 'logical-pathname)
        (equalt (pathname-name pn) (pathname-name tn))
        (equalt (pathname-type pn) (pathname-type tn))
        ))))
42 43 44 45 46 47 48
  t nil t t)

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

57 58
(deftest truename.5
  (let* ((lpn "CLTEST:foo.txt")
sds's avatar
sds committed
59
         (pn (translate-logical-pathname lpn)))
60 61 62 63 64 65
    (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
66
           t (list (pathname-name pn) (pathname-name tn)))
67
       (if (equalt (pathname-type pn) (pathname-type tn))
sds's avatar
sds committed
68
           t (list (pathname-type pn) (pathname-type tn)))
69 70 71
       )))
  t t t)

72 73 74 75 76 77 78 79 80
;;; Specialized string tests

(deftest truename.6
  (do-special-strings
   (s "truename.lsp" nil)
   (assert (equalp (truename s) (truename "truename.lsp"))))
  nil)

;;; Error tests
81 82

(deftest truename.error.1
83 84
  (signals-error (truename) program-error)
  t)
85 86

(deftest truename.error.2
87 88
  (signals-error (truename "truename.lsp" nil) program-error)
  t)
89 90

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

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

(deftest truename.error.5
99 100
  (signals-error-always (truename (logical-pathname "CLTESTROOT:nonexistent")) 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)