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

(in-package :cl-test)

(deftest enough-namestring.1
  (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp")))
sds's avatar
sds committed
10
         (s (first vals)))
11
    (if (and (null (cdr vals))
sds's avatar
sds committed
12 13 14
             (stringp s)
             (equal (enough-namestring s) s))
        :good
15 16 17 18 19 20 21 22 23 24 25 26 27
      vals))
  :good)

(deftest enough-namestring.2
  (do-special-strings
   (s "enough-namestring.lsp" nil)
   (let ((ns (enough-namestring s)))
     (assert (stringp ns))
     (assert (string= (enough-namestring ns) ns))))
  nil)

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

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

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

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

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

;;; Error tests

(deftest enough-namestring.error.1
  (signals-error (enough-namestring) program-error)
  t)

(deftest enough-namestring.error.2
  (signals-error
   (enough-namestring "enough-namestring.lsp" *default-pathname-defaults* nil)
   program-error)
  t)