source: trunk/source/tests/ansi-tests/enough-namestring.lsp @ 8991

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

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

File size: 2.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Sep 12 06:23:50 2004
4;;;; Contains: Tests of ENOUGH-NAMESTRING
5
6(in-package :cl-test)
7
8(deftest enough-namestring.1
9  (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp")))
10         (s (first vals)))
11    (if (and (null (cdr vals))
12             (stringp s)
13             (equal (enough-namestring s) s))
14        :good
15      vals))
16  :good)
17
18(deftest enough-namestring.2
19  (do-special-strings
20   (s "enough-namestring.lsp" nil)
21   (let ((ns (enough-namestring s)))
22     (assert (stringp ns))
23     (assert (string= (enough-namestring ns) ns))))
24  nil)
25
26(deftest enough-namestring.3
27  (let* ((name "enough-namestring.lsp")
28         (pn (merge-pathnames (pathname name)))
29         (name2 (enough-namestring pn))
30         (name3 (enough-namestring name)))
31    (or (equalt name2 name3) (list name2 name3)))
32  t)
33
34(deftest enough-namestring.4
35  (let* ((name "enough-namestring.lsp")
36         (pn (merge-pathnames (pathname name)))
37         (name2 (with-open-file (s pn :direction :input) (enough-namestring s)))
38         (name3 (enough-namestring name)))
39    (or (equalt name2 name3) (list name2 name3)))
40  t)
41
42(deftest enough-namestring.5
43  (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp"
44                                                       *default-pathname-defaults*)))
45         (s (first vals)))
46    (if (and (null (cdr vals))
47             (stringp s)
48             (equal (enough-namestring s) s))
49        :good
50      vals))
51  :good)
52
53(deftest enough-namestring.6
54  (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp"
55                                                       (namestring *default-pathname-defaults*))))
56         (s (first vals)))
57    (if (and (null (cdr vals))
58             (stringp s)
59             (equal (enough-namestring s) s))
60        :good
61      vals))
62  :good)
63
64(deftest enough-namestring.7
65  (do-special-strings
66   (s (namestring *default-pathname-defaults*) nil)
67   (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" s)))
68         (s2 (first vals)))
69     (assert (null (cdr vals)))
70     (assert (stringp s2))
71     (assert (equal (enough-namestring s2) s2))))
72  nil)
73
74;;; Error tests
75
76(deftest enough-namestring.error.1
77  (signals-error (enough-namestring) program-error)
78  t)
79
80(deftest enough-namestring.error.2
81  (signals-error
82   (enough-namestring "enough-namestring.lsp" *default-pathname-defaults* nil)
83   program-error)
84  t)
Note: See TracBrowser for help on using the repository browser.