enough-namestring.lsp 2.57 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Sep 12 06:23:50 2004
;;;; Contains: Tests of ENOUGH-NAMESTRING

6

7 8

(deftest enough-namestring.1
9
    (let* ((vals (multiple-value-list
10
                  (enough-namestring "enough-namestring.txt")))
11 12 13 14 15 16
           (s (first vals)))
      (if (and (null (cdr vals))
               (stringp s)
               (equal (enough-namestring s) s))
          :good
          vals))
17 18 19 20
  :good)

(deftest enough-namestring.2
  (do-special-strings
21
   (s "enough-namestring.txt" nil)
22 23 24 25 26 27
   (let ((ns (enough-namestring s)))
     (assert (stringp ns))
     (assert (string= (enough-namestring ns) ns))))
  nil)

(deftest enough-namestring.3
28
  (let* ((name "enough-namestring.txt")
sds's avatar
sds committed
29 30 31
         (pn (merge-pathnames (pathname name)))
         (name2 (enough-namestring pn))
         (name3 (enough-namestring name)))
32 33 34 35
    (or (equalt name2 name3) (list name2 name3)))
  t)

(deftest enough-namestring.4
36
  (let* ((name "enough-namestring.txt")
sds's avatar
sds committed
37 38 39
         (pn (merge-pathnames (pathname name)))
         (name2 (with-open-file (s pn :direction :input) (enough-namestring s)))
         (name3 (enough-namestring name)))
40 41 42 43
    (or (equalt name2 name3) (list name2 name3)))
  t)

(deftest enough-namestring.5
44
  (let* ((vals (multiple-value-list
45
                (enough-namestring "enough-namestring.txt"
46
                                   *default-pathname-defaults*)))
sds's avatar
sds committed
47
         (s (first vals)))
48
    (if (and (null (cdr vals))
sds's avatar
sds committed
49 50 51
             (stringp s)
             (equal (enough-namestring s) s))
        :good
52
        vals))
53 54 55
  :good)

(deftest enough-namestring.6
56
    (let* ((vals (multiple-value-list
57
                  (enough-namestring "enough-namestring.txt"
58 59 60 61 62 63 64
                                     (namestring *default-pathname-defaults*))))
           (s (first vals)))
      (if (and (null (cdr vals))
               (stringp s)
               (equal (enough-namestring s) s))
          :good
          vals))
65 66 67
  :good)

(deftest enough-namestring.7
68 69 70
    (do-special-strings
        (s (namestring *default-pathname-defaults*) nil)
      (let* ((vals (multiple-value-list
71
                    (enough-namestring "enough-namestring.txt" s)))
72 73 74 75
             (s2 (first vals)))
        (assert (null (cdr vals)))
        (assert (stringp s2))
        (assert (equal (enough-namestring s2) s2))))
76 77 78 79 80
  nil)

;;; Error tests

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

(deftest enough-namestring.error.2
85
    (signals-error
86
     (enough-namestring "enough-namestring.txt"
87 88
                        *default-pathname-defaults* nil)
     program-error)
89
  t)