/[gcl]/gcl/tests/path.tst
ViewVC logotype

Diff of /gcl/tests/path.tst

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Thu Dec 20 20:29:54 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 UTC
# Line 0  Line 1 
1    (setf string "test-pathname.abc" symbol 'test-pathname.abc)
2    test-pathname.abc
3    
4    ;;pathname -mögl. Argumenttypen: pathname,string,symbol,stream
5    ;;         -resultat: pathname
6    
7    (SETF PATHSTRING (PATHNAME STRING))
8    #+XCL
9    #S(PATHNAME SYSTEM::HOST NIL
10    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
11    TYPE "ABC" SYSTEM::VERSION NIL)
12    #+CLISP
13    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
14                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
15    
16    (SETF PATHSYMBOL (PATHNAME symbol))
17    #+XCL
18    #S(PATHNAME SYSTEM::HOST
19    NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
20    "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
21    #+CLISP
22    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
23                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
24    
25    (SETF PATHPATH (PATHNAME PATHSYMBOL))
26    #+XCL
27    #S(PATHNAME SYSTEM::HOST NIL
28    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
29    TYPE "ABC" SYSTEM::VERSION NIL)
30    #+CLISP
31    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
32                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
33    
34    (SETF STREAM (OPEN STRING :DIRECTION :OUTPUT)
35          a nil)
36    nil
37    
38    ;(SETF PATHSTREAM (PATHNAME STREAM))
39    ;"test-pathname.lsp"
40    
41    (MAPCAR (FUNCTION PATHNAMEP)
42            (LIST PATHSTRING PATHSYMBOL PATHPATH ;PATHSTREAM
43    ))
44    (T T T ;T
45    )
46    
47    
48    ;; funktion truename liefert filename fuer pathname oder stream
49    ;;                   einen Pfadnamen
50    ;
51    ;(MAPCAR (FUNCTION TRUENAME) (LIST PATHSTRING PATHSYMBOL PATHPATH STREAM
52    ;                                                               ;PATHSTREAM
53    ;                                                                 ))
54    ;  ERROR
55    
56    
57    
58    (PARSE-NAMESTRING STRING)
59    #+XCL
60    #S(PATHNAME SYSTEM::HOST NIL
61    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
62    TYPE "ABC" SYSTEM::VERSION NIL)
63    #+CLISP
64    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
65                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
66    
67    (PARSE-NAMESTRING SYMBOL)
68    #+XCL
69    #S(PATHNAME SYSTEM::HOST NIL
70    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
71    TYPE "ABC" SYSTEM::VERSION NIL)
72    #+CLISP
73    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
74                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
75    
76    #+XCL
77    (PARSE-NAMESTRING "bab:test-pathname.abc")
78    #+XCL
79    #S(PATHNAME SYSTEM::HOST NIL
80    SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME
81    "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
82    
83    #+XCL
84    (PARSE-NAMESTRING "bab:test-pathname.abc;3")
85    #+XCL
86    #S(PATHNAME SYSTEM::HOST NIL
87    SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME
88    "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION 3)
89    
90    (PARSE-NAMESTRING PATHSTRING)
91    #+XCL
92    #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
93    "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC"
94    SYSTEM::VERSION NIL)
95    #+CLISP
96    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
97                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
98    
99    (PARSE-NAMESTRING "test-pathname.abc" NIL)
100    #+XCL
101    #S(PATHNAME SYSTEM::HOST NIL
102    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST-PATHNAME"
103    TYPE "ABC" SYSTEM::VERSION NIL)
104    #+CLISP
105    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
106                :NAME "test-pathname" :TYPE "abc" :VERSION NIL)
107    
108    #+XCL
109    (PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc")
110    #+XCL
111    #S(PATHNAME
112    SYSTEM::HOST "SIRIUS" SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "HEICKING"
113    SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
114    
115    #+XCL
116    (PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc" "sirius")
117    #+XCL
118    #S(PATHNAME
119    SYSTEM::HOST "SIRIUS" SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "HEICKING"
120    SYSTEM::NAME "TEST-PATHNAME" TYPE "ABC" SYSTEM::VERSION NIL)
121    
122    #+XCL
123    (PARSE-NAMESTRING "sirius::disk00$abt43:[heicking]test-pathname.abc" "orion")
124    #+XCL
125    ERROR
126    
127    (PARSE-NAMESTRING "abc.123" NIL NIL :START 0 :END 5)
128    #+XCL
129    #S(PATHNAME SYSTEM::HOST
130    NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "ABC" TYPE
131    "1" SYSTEM::VERSION NIL)
132    #+CLISP
133    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
134                :NAME "abc" :TYPE "1" :VERSION NIL)
135    
136    (PARSE-NAMESTRING "abc.123" NIL NIL :START 2 :END 5)
137    #+XCL
138    #S(PATHNAME SYSTEM::HOST
139    NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "C" TYPE "1"
140    SYSTEM::VERSION NIL)
141    #+CLISP
142    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
143                :NAME "c" :TYPE "1" :VERSION NIL)
144    
145    #+XCL
146    (PARSE-NAMESTRING "babylon" NIL NIL :START 0 :END 3)
147    #+XCL
148    #S(PATHNAME SYSTEM::HOST
149    NIL SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2" SYSTEM::NAME NIL TYPE
150    NIL SYSTEM::VERSION NIL)
151    
152    #+XCL
153    (PARSE-NAMESTRING "babylon" NIL NIL :START 0 :END 7)
154    #+XCL
155    #S(PATHNAME SYSTEM::HOST
156    NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "BABYLON"
157    TYPE NIL SYSTEM::VERSION NIL)
158    
159    #+XCL
160    (PARSE-NAMESTRING "babylon" NIL *DEFAULT-PATHNAME-DEFAULTS* :START 0 :END 7)
161    #+XCL
162    #S(PATHNAME
163    SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
164    "BABYLON" TYPE NIL SYSTEM::VERSION NIL)
165    
166    *DEFAULT-PATHNAME-DEFAULTS*
167    #+XCL
168    #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE NIL
169    DIRECTORY NIL SYSTEM::NAME NIL TYPE "lsp" SYSTEM::VERSION :NEWEST)
170    #+CLISP
171    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
172                :NAME NIL :TYPE NIL :VERSION NIL)
173    
174    #+XCL
175    (PARSE-NAMESTRING "babylon" NIL *DEFAULT-PATHNAME-DEFAULTS* :START 0 :END 3)
176    #+XCL
177    #S(PATHNAME
178    SYSTEM::HOST NIL SYSTEM::DEVICE "$1$DUA70" DIRECTORY "43.BABYLON.REL2"
179    SYSTEM::NAME NIL TYPE NIL SYSTEM::VERSION NIL)
180    
181    ;(PARSE-NAMESTRING "babylon.c.c" NIL NIL :JUNK-ALLOWED T)
182    ;#S(PATHNAME
183    ;SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
184    ;"BABYLON" TYPE "C" SYSTEM::VERSION NIL)
185    
186    ;(PARSE-NAMESTRING "babylon;c.c" NIL NIL :JUNK-ALLOWED T)
187    ;#S(PATHNAME
188    ;SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
189    ;"BABYLON" TYPE NIL SYSTEM::VERSION NIL)
190    
191    #+XCL
192    (PARSE-NAMESTRING "babylon;c.c" NIL NIL :JUNK-ALLOWED NIL)
193    #+XCL
194    ERROR
195    
196    #+XCL
197    (PARSE-NAMESTRING "babylon.c.c" NIL NIL :JUNK-ALLOWED NIL)
198    #+XCL
199    ERROR
200    
201    #+XCL
202    (PARSE-NAMESTRING "babylon.c;c" NIL NIL :JUNK-ALLOWED NIL)
203    #+XCL
204    ERROR
205    
206    #+XCL
207    (PARSE-NAMESTRING "babylon.c;" NIL NIL :JUNK-ALLOWED NIL)
208    #+XCL
209    #S(PATHNAME
210    SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
211    "BABYLON" TYPE "C" SYSTEM::VERSION NIL)
212    
213    #+XCL
214    (PARSE-NAMESTRING "babylon.c;5" NIL NIL :JUNK-ALLOWED NIL)
215    #+XCL
216    #S(PATHNAME
217    SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME
218    "BABYLON" TYPE "C" SYSTEM::VERSION 5)
219    
220    ;(MERGE-PATHNAME "test$$" SYMBOL 10)   ERROR
221    ;;
222    ;(MERGE-PATHNAME "test$$" SYMBOL)   ERROR
223    ;
224    ;(MERGE-PATHNAME "test$$" PATH)   ERROR
225    ;
226    ;(MERGE-PATHNAME "test$$")   ERROR
227    
228    #+XCL
229    (MERGE-PATHNAMES "test$$")
230    #+XCL
231    #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
232    "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE "lsp"
233    SYSTEM::VERSION :NEWEST)
234    
235    #+XCL
236    (MERGE-PATHNAMES "test$$" SYMBOL)
237    #+XCL
238    #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
239    "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE "ABC"
240    SYSTEM::VERSION :NEWEST)
241    
242    #+XCL
243    (MERGE-PATHNAMES "test$$" SYMBOL 2)
244    #+XCL
245    #S(PATHNAME SYSTEM::HOST NIL
246    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE
247    "ABC" SYSTEM::VERSION 2)
248    
249    #+XCL
250    (MERGE-PATHNAMES "test$$" (PATHNAME SYMBOL) 2)
251    #+XCL
252    #S(PATHNAME SYSTEM::HOST NIL
253    SYSTEM::DEVICE "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE
254    "ABC" SYSTEM::VERSION 2)
255    
256    #+XCL
257    (MERGE-PATHNAMES "test$$" STREAM 2)
258    #+XCL
259    #S(PATHNAME SYSTEM::HOST 16 SYSTEM::DEVICE
260    "DISK00$ABT43" DIRECTORY "XCL.MAIN" SYSTEM::NAME "TEST$$" TYPE :ESCAPE
261    SYSTEM::VERSION 2)
262    
263    
264    ;(MERGE-PATHNAME STRING SYMBOL)   ERROR
265    
266    #+XCL
267    (MAKE-PATHNAME :NAME "a" :HOST (QUOTE ORION))
268    #+XCL
269    #S(PATHNAME SYSTEM::HOST ORION
270    SYSTEM::DEVICE NIL DIRECTORY NIL SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION
271    :NEWEST)
272    
273    #+XCL
274    (DEFMACRO TEST (&REST BODY) (\` (APPLY (FUNCTION MAKE-PATHNAME) (\,@ BODY))))
275    #+XCL
276    TEST
277    
278    #+XCL
279    (setf a '(:host "sirius" :name "a"))
280    #+XCL
281    (:host "sirius" :name "a")
282    
283    #+XCL
284    (TEST A)
285    #+XCL
286    #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE NIL DIRECTORY NIL
287    SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION :NEWEST)
288    
289    #+XCL
290    (SETF A (LIST* :DEVICE "disk00$abt43" A))
291    #+XCL
292    (:DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
293    
294    #+XCL
295    (TEST A)
296    #+XCL
297    #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
298    DIRECTORY NIL SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION :NEWEST)
299    
300    #+XCL
301    (SETF A (LIST* :DIRECTORY "[heicking.comlisp]" A))
302    #+XCL
303    (:DIRECTORY
304    "[heicking.comlisp]" :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
305    
306    #+XCL
307    (TEST A)
308    #+XCL
309    #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
310    DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE NIL SYSTEM::VERSION
311    :NEWEST)
312    
313    #+XCL
314    (SETF A (LIST* :TYPE "raf" A))
315    #+XCL
316    (:TYPE "raf" :DIRECTORY "[heicking.comlisp]"
317    :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
318    
319    #+XCL
320    (TEST A)
321    #+XCL
322    #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
323    DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf" SYSTEM::VERSION
324    :NEWEST)
325    
326    #+XCL
327    (SETF A (LIST* :VERSION 3 A))
328    #+XCL
329    (:VERSION 3 :TYPE "raf" :DIRECTORY
330    "[heicking.comlisp]" :DEVICE "disk00$abt43" :HOST "sirius" :NAME "a")
331    
332    #+XCL
333    (TEST A)
334    #+XCL
335    #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE "disk00$abt43"
336    DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf" SYSTEM::VERSION 3)
337    
338    (MAPCAR (FUNCTION PATHNAMEP) (LIST PATHSYMBOL PATHPATH PATHSTRING))
339    (T T T)
340    
341    #+XCL
342    (SETF PATH (TEST A))
343    #+XCL
344    #S(PATHNAME SYSTEM::HOST "sirius" SYSTEM::DEVICE
345    "disk00$abt43" DIRECTORY "[heicking.comlisp]" SYSTEM::NAME "a" TYPE "raf"
346    SYSTEM::VERSION 3)
347    
348    #+XCL
349    (MAPCAR (FUNCTION PATHNAME-HOST) (LIST SYMBOL STRING STREAM PATH))
350    #+XCL
351    (NIL NIL NIL NIL)
352    
353    #+XCL
354    (MAPCAR (FUNCTION PATHNAME-DEVICE) (LIST SYMBOL STRING STREAM PATH))
355    #+XCL
356    ("DISK00$ABT43" "DISK00$ABT43" "DISK00$ABT43" "DISK00$ABT43")
357    
358    #+XCL
359    (MAPCAR (FUNCTION PATHNAME-DIRECTORY) (LIST SYMBOL STRING STREAM PATH))
360    #+XCL
361    ("XCL.MAIN" "XCL.MAIN" "XCL.MAIN" "XCL.MAIN")
362    
363    (PROGN (CLOSE STREAM) T)
364    T
365    
366    #+XCL
367    (USER-HOMEDIR-PATHNAME)
368    #+XCL
369    #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE
370    "DISK00$ABT43" DIRECTORY "HEICKING" SYSTEM::NAME NIL TYPE NIL SYSTEM::VERSION
371    NIL)
372    
373    (PATHNAME "*.*")
374    #+XCL
375    #S(PATHNAME SYSTEM::HOST NIL SYSTEM::DEVICE "DISK00$ABT43"
376    DIRECTORY "HEICKING" SYSTEM::NAME "*" TYPE :WILD SYSTEM::VERSION NIL)
377    #+CLISP
378    #S(PATHNAME :HOST NIL :DEVICE NIL :DIRECTORY (:RELATIVE)
379                :NAME "*" :TYPE "*" :VERSION NIL)
380    
381    (progn (setf file (open "nicht-vorhandenes-file.non"
382                            :direction :input
383                            :element-type 'string-char
384                            :if-does-not-exist :create)) t)
385    t
386    
387    (null (probe-file "nicht-vorhandenes-file.non"))
388    NIL
389    
390    (progn (close file) t)
391    t
392    
393    (setf file (open "nicht-vorhandenes-file.non"
394                            :direction :io
395                            :element-type 'string-char
396                            :if-exists :error))
397    error
398    
399    (progn (close file) t)
400    t
401    
402    (null (setf file (open "nicht-vorhandenes-file.non"
403                            :direction :io
404                            :element-type 'string-char
405                            :if-exists :new-version)))
406    nil
407    
408    (progn (close file) t)
409    t
410    
411    (null (setf file (open "nicht-vorhandenes-file.non"
412                            :direction :io
413                            :element-type 'string-char
414                            :if-exists :rename)))
415    nil
416    
417    (progn (close file) t)
418    t
419    
420    (null (setf file (open "nicht-vorhandenes-file.non"
421                            :direction :io
422                            :element-type 'string-char
423                            :if-exists :rename-and-delete)))
424    nil
425    
426    (progn (close file) t)
427    t
428    
429    (null (setf file (open "nicht-vorhandenes-file.non"
430                            :direction :io
431                            :element-type 'string-char
432                            :if-exists :overwrite)))
433    nil
434    
435    (progn (close file) t)
436    t
437    
438    (null (setf file (open "nicht-vorhandenes-file.non"
439                            :direction :io
440                            :element-type 'string-char
441                            :if-exists :append)))
442    nil
443    
444    (progn (close file) t)
445    t
446    
447    (null (setf file (open "nicht-vorhandenes-file.non"
448                            :direction :io
449                            :element-type 'string-char
450                            :if-exists :supersede)))
451    nil
452    
453    (progn (close file) t)
454    t
455    
456    (setf file (open "nicht-vorhandenes-file.non"
457                            :direction :io
458                            :element-type 'string-char
459                            :if-exists nil))
460    nil
461    
462    (progn (close file) t)
463    error
464    
465    (setf file (open "nicht-vorhandenes-file.new"
466                            :direction :io
467                            :element-type 'string-char
468                            :if-does-not-exist :error))
469    error
470    
471    (progn (close file) t)
472    error
473    
474    (null (setf file (open "nicht-vorhandenes-file.new"
475                            :direction :io
476                            :element-type 'string-char
477                            :if-does-not-exist :create)))
478    nil
479    
480    (progn (close file) t)
481    t
482    
483    (null (setf file (open "nicht-vorhandenes-file.non"
484                            :direction :io
485                            :element-type 'string-char
486                            :if-does-not-exist nil)))
487    nil
488    
489    (progn (close file) t)
490    t
491    
492    (namestring
493      (multiple-value-setq (new-name pathname truename)
494                         (rename-file "nicht-vorhandenes-file.non" "file.da")))
495    "file.da"
496    
497    (namestring new-name)
498    "file.da"
499    
500    (null pathname)
501    nil
502    
503    (null truename)
504    nil
505    
506    (progn (delete-file "test-pathname.abc") t)
507    t
508    
509    (progn (mapc #'delete-file (directory "nicht-vorhandenes-file.*")) t)
510    t
511    
512    (progn (delete-file "file.da") t)
513    t
514    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26