← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/truename.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/truename.lsp
 
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
;;;
 
73
 
 
74
(deftest truename.error.1
 
75
  (signals-error (truename) program-error)
 
76
  t)
 
77
 
 
78
(deftest truename.error.2
 
79
  (signals-error (truename "truename.lsp" nil) program-error)
 
80
  t)
 
81
 
 
82
(deftest truename.error.3
 
83
  (signals-error (truename "nonexistent") file-error)
 
84
  t)
 
85
 
 
86
(deftest truename.error.4
 
87
  (signals-error (truename #p"nonexistent") file-error)
 
88
  t)
 
89
 
 
90
(deftest truename.error.5
 
91
  (signals-error (truename (logical-pathname "CLTESTROOT:nonexistent")) file-error)
 
92
  t)
 
93
 
 
94
(deftest truename.error.6
 
95
  (signals-error
 
96
   (let ((pn (make-pathname :name :wild
 
97
                            :defaults *default-pathname-defaults*)))
 
98
     (truename pn)) file-error)
 
99
  t)
 
100
 
 
101
 
 
102
 
 
103
 
 
104