1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / filesys.test.sh
1 #!/bin/sh
2
3 # This software is part of the SBCL system. See the README file for
4 # more information.
5 #
6 # While most of SBCL is derived from the CMU CL system, the test
7 # files (like this one) were written from scratch after the fork
8 # from CMU CL.
9 #
10 # This software is in the public domain and is provided with
11 # absolutely no warranty. See the COPYING and CREDITS files for
12 # more information.
13
14 . ./subr.sh
15
16 use_test_subdirectory
17 testdir="`pwd -P`" # resolve symbolic links in the directory.
18
19 set -f # disable filename expansion in the shell.
20
21 # Test DIRECTORY and TRUENAME.
22 echo this is a test > test-1.tmp
23 echo this is a test > test-2.tmp
24 echo this is a test > wild?test.tmp
25
26 ln -s "$testdir" dirlinktest
27 ln -s test-1.tmp link-1
28 ln -s "$testdir/test-2.tmp" link-2
29 ln -s i-do-not-exist link-3
30 ln -s link-4 link-4
31 ln -s link-5 link-6
32 ln -s "$testdir/link-6" link-5
33 expected_truenames=`cat<<EOF
34 (list #p"$testdir/"
35       #p"$testdir/link-3"
36       #p"$testdir/link-4"
37       #p"$testdir/link-5"
38       #p"$testdir/link-6"
39       #p"$testdir/test-1.tmp"
40       #p"$testdir/test-2.tmp"
41       #p"$testdir/wild\\\\\?test.tmp")
42 EOF
43 `
44 # FIXME: the following tests probably can't succeed at all if the
45 # testdir name contains wildcard characters or quotes.
46 run_sbcl <<EOF
47   (in-package :cl-user)
48   (let* ((directory (directory "./*.*"))
49          (truenames (sort directory #'string< :key #'pathname-name)))
50     (format t "~&TRUENAMES=~S~%" truenames)
51     (finish-output)
52     (assert (equal truenames $expected_truenames)))
53   (assert (equal (truename "dirlinktest") #p"$testdir/"))
54   (assert (equal (truename "dirlinktest/") #p"$testdir/"))
55   (assert (equal (truename "test-1.tmp") #p"$testdir/test-1.tmp"))
56   (assert (equal (truename "link-1")     #p"$testdir/test-1.tmp"))
57   (assert (equal (truename "link-2")     #p"$testdir/test-2.tmp"))
58   (assert (equal (truename "link-3")     #p"$testdir/link-3"))
59   (assert (equal (truename "link-4")     #p"$testdir/link-4"))
60   (assert (equal (truename "link-5")     #p"$testdir/link-5"))
61   (assert (equal (truename "link-6")     #p"$testdir/link-6"))
62   (sb-ext:quit :unix-status $EXIT_LISP_WIN)
63 EOF
64 check_status_maybe_lose "DIRECTORY/TRUENAME part 1" $?
65
66 cd "$SBCL_PWD"
67 run_sbcl <<EOF
68   (in-package :cl-user)
69   (let* ((directory (directory "$testdir/*.*"))
70          (truenames (sort directory #'string< :key #'pathname-name)))
71     (format t "~&TRUENAMES=~S~%" truenames)
72     (finish-output)
73     (assert (equal truenames $expected_truenames)))
74   (assert (equal (truename "$testdir/test-1.tmp") #p"$testdir/test-1.tmp"))
75   (assert (equal (truename "$testdir/link-1")     #p"$testdir/test-1.tmp"))
76   (assert (equal (truename "$testdir/link-2")     #p"$testdir/test-2.tmp"))
77   (assert (equal (truename "$testdir/link-3")     #p"$testdir/link-3"))
78   (assert (equal (truename "$testdir/link-4")     #p"$testdir/link-4"))
79   (assert (equal (truename "$testdir/link-5")     #p"$testdir/link-5"))
80   (assert (equal (truename "$testdir/link-6")     #p"$testdir/link-6"))
81   (sb-ext:quit :unix-status $EXIT_LISP_WIN)
82 EOF
83 check_status_maybe_lose "DIRECTORY/TRUENAME part 2" $?
84 cleanup_test_subdirectory
85
86 # Test DIRECTORY on a tree structure of directories.
87 use_test_subdirectory
88
89 touch water dirt
90 mkdir animal plant
91 mkdir animal/vertebrate animal/invertebrate
92 mkdir animal/vertebrate/mammal
93 mkdir animal/vertebrate/snake
94 mkdir animal/vertebrate/bird
95 mkdir animal/vertebrate/mammal/bear
96 mkdir animal/vertebrate/mammal/mythical
97 mkdir animal/vertebrate/mammal/rodent
98 mkdir animal/vertebrate/mammal/ruminant
99 touch animal/vertebrate/mammal/platypus
100 touch animal/vertebrate/mammal/walrus
101 touch animal/vertebrate/mammal/bear/grizzly
102 touch animal/vertebrate/mammal/mythical/mermaid
103 touch animal/vertebrate/mammal/mythical/unicorn
104 touch animal/vertebrate/mammal/rodent/beaver
105 touch animal/vertebrate/mammal/rodent/mouse
106 touch animal/vertebrate/mammal/rodent/rabbit
107 touch animal/vertebrate/mammal/rodent/rat
108 touch animal/vertebrate/mammal/ruminant/cow
109 touch animal/vertebrate/snake/python
110 touch plant/kingsfoil plant/pipeweed
111 run_sbcl <<EOF
112 (in-package :cl-user)
113 (defun absolutify (pathname)
114   "Convert a possibly-relative pathname to absolute."
115   (merge-pathnames pathname
116                    (make-pathname :directory
117                                   (pathname-directory
118                                    *default-pathname-defaults*))))
119 (defun sorted-truenamestrings (pathname-designators)
120   "Convert a collection of pathname designators into canonical form
121 using TRUENAME, NAMESTRING, and SORT."
122   (sort (mapcar #'namestring
123                 (mapcar #'truename
124                         pathname-designators))
125         #'string<))
126 (defun need-match-1 (directory-pathname result-sorted-truenamestrings)
127   "guts of NEED-MATCH"
128   (let ((directory-sorted-truenamestrings (sorted-truenamestrings
129                                            (directory directory-pathname))))
130     (unless (equal directory-sorted-truenamestrings
131                    result-sorted-truenamestrings)
132       (format t "~&~@<DIRECTORY argument = ~_~2I~S~:>~%"
133               directory-pathname)
134       (format t "~&~@<DIRECTORY result = ~_~2I~S~:>~%"
135               directory-sorted-truenamestrings)
136       (format t "~&~@<expected result = ~_~2I~S.~:>~%"
137               result-sorted-truenamestrings)
138       (error "mismatch between DIRECTORY and expected result"))))
139 (defun need-match (directory-pathname result-pathnames)
140   "Require that (DIRECTORY DIRECTORY-PATHNAME) return RESULT-PATHNAMES
141 (modulo TRUENAME and NAMESTRING applied to each RESULT-PATHNAME for
142 convenience in e.g. converting Unix filename syntax idiosyncrasies to
143 Lisp filename syntax idiosyncrasies)."
144   (let ((sorted-result-truenamestrings (sorted-truenamestrings
145                                         result-pathnames)))
146   ;; Relative and absolute pathnames should give the same result.
147   (need-match-1 directory-pathname
148                 sorted-result-truenamestrings)
149   (need-match-1 (absolutify directory-pathname)
150                 sorted-result-truenamestrings)))
151 (defun need-matches ()
152   "lotso calls to NEED-MATCH"
153   ;; FIXME: As discussed on sbcl-devel ca. 2001-01-01, DIRECTORY should
154   ;; report Unix directory files contained within its output as e.g.
155   ;; "/usr/bin" instead of the CMU-CL-style "/usr/bin/". In that case,
156   ;; s:/":": in most or all the NEED-MATCHes here.
157   (need-match "./*.*" '("animal/" "dirt" "plant/" "water"))
158   (need-match "*.*" '("animal/" "dirt" "plant/" "water"))
159   (need-match "animal" '("animal/"))
160   (need-match "./animal" '("animal/"))
161   (need-match "animal/*.*" '("animal/invertebrate/" "animal/vertebrate/"))
162   (need-match "animal/*/*.*"
163               '("animal/vertebrate/bird/"
164                 "animal/vertebrate/mammal/"
165                 "animal/vertebrate/snake/"))
166   (need-match "plant/*.*" '("plant/kingsfoil" "plant/pipeweed"))
167   (need-match "plant/**/*.*" '("plant/kingsfoil" "plant/pipeweed"))
168   (need-match "plant/**/**/*.*" '("plant/kingsfoil" "plant/pipeweed"))
169   (let ((vertebrates (mapcar (lambda (stem)
170                                (concatenate 'string
171                                             "animal/vertebrate/"
172                                             stem))
173                              '("bird/"
174                                "mammal/"
175                                "mammal/bear/" "mammal/bear/grizzly"
176                                "mammal/mythical/" "mammal/mythical/mermaid"
177                                "mammal/mythical/unicorn"
178                                "mammal/platypus"
179                                "mammal/rodent/" "mammal/rodent/beaver"
180                                "mammal/rodent/mouse" "mammal/rodent/rabbit"
181                                "mammal/rodent/rat"
182                                "mammal/ruminant/" "mammal/ruminant/cow"
183                                "mammal/walrus"
184                                "snake/" "snake/python"))))
185     (need-match "animal/vertebrate/**/*.*" vertebrates)
186     (need-match "animal/vertebrate/mammal/../**/*.*" vertebrates)
187     (need-match "animal/vertebrate/mammal/../**/**/*.*" vertebrates)
188     #+nil
189     (need-match "animal/vertebrate/mammal/mythical/../**/../**/*.*"
190                 vertebrates))
191   (need-match "animal/vertebrate/**/robot.*" nil)
192   (need-match "animal/vertebrate/mammal/../**/*.robot" nil)
193   (need-match "animal/vertebrate/mammal/../**/robot/*.*" nil)
194   #+nil
195   (need-match "animal/vertebrate/mammal/robot/../**/../**/*.*" nil))
196 (need-matches)
197 (sb-ext:quit :unix-status $EXIT_LISP_WIN)
198 EOF
199 check_status_maybe_lose "DIRECTORY/TRUENAME part 3" $?
200
201 # Test whether ENSURE-DIRECTORIES-EXIST can create a directory whose
202 # name contains a wildcard character (it used to get itself confused
203 # internally).
204 run_sbcl --eval '(ensure-directories-exist "foo\\*bar/baz.txt")' --eval '(sb-ext:quit)'
205 test -d foo*bar
206 check_status_maybe_lose "ENSURE-DIRECTORIES-EXIST part 1" $? \
207     0 "(directory exists)"
208
209 run_sbcl --eval '(ensure-directories-exist "foo\\?bar/baz.txt")' --eval '(sb-ext:quit)'
210 test -d foo?bar
211 check_status_maybe_lose "ENSURE-DIRECTORIES-EXIST part 2" $? \
212     0 "(directory exists)"
213
214 # success convention for script
215 exit $EXIT_TEST_WIN