Commit | Line | Data |
---|---|---|
8ab3d8a0 KR |
1 | ;;;; ftw.test --- exercise ice-9/ftw.scm -*- scheme -*- |
2 | ;;;; | |
3 | ;;;; Copyright 2006 Free Software Foundation, Inc. | |
4 | ;;;; | |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
8ab3d8a0 KR |
9 | ;;;; |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | (define-module (test-suite test-ice-9-ftw) | |
20 | #:use-module (test-suite lib) | |
21 | #:use-module (ice-9 ftw)) | |
22 | ||
23 | ||
24 | ;; the procedure-source checks here ensure the vector indexes we write match | |
25 | ;; what ice-9/posix.scm stat:dev and stat:ino do (which in turn match | |
26 | ;; libguile/filesys.c of course) | |
27 | ||
8ab3d8a0 KR |
28 | (define (stat:dev! st dev) |
29 | (vector-set! st 0 dev)) | |
8ab3d8a0 KR |
30 | (define (stat:ino! st ino) |
31 | (vector-set! st 1 ino)) | |
32 | ||
7ff01700 AW |
33 | (let* ((s (stat "/")) |
34 | (i (stat:ino s)) | |
35 | (d (stat:dev s))) | |
36 | (stat:ino! s (1+ i)) | |
37 | (stat:dev! s (1+ d)) | |
38 | (if (not (and (= (stat:ino s) (1+ i)) | |
39 | (= (stat:dev s) (1+ d)))) | |
40 | (error "unexpected definitions of stat:dev and stat:ino"))) | |
8ab3d8a0 KR |
41 | |
42 | ;; | |
43 | ;; visited?-proc | |
44 | ;; | |
45 | ||
46 | (with-test-prefix "visited?-proc" | |
47 | ||
48 | ;; normally internal-only | |
49 | (let* ((visited?-proc (@@ (ice-9 ftw) visited?-proc)) | |
50 | (visited? (visited?-proc 97)) | |
51 | (s (stat "/"))) | |
52 | ||
53 | (define (try-visited? dev ino) | |
54 | (stat:dev! s dev) | |
55 | (stat:ino! s ino) | |
56 | (visited? s)) | |
57 | ||
58 | (pass-if "0 0 - 1st" (eq? #f (try-visited? 0 0))) | |
59 | (pass-if "0 0 - 2nd" (eq? #t (try-visited? 0 0))) | |
60 | (pass-if "0 0 - 3rd" (eq? #t (try-visited? 0 0))) | |
61 | ||
62 | (pass-if "0 1" (eq? #f (try-visited? 0 1))) | |
63 | (pass-if "0 2" (eq? #f (try-visited? 0 2))) | |
64 | (pass-if "0 3" (eq? #f (try-visited? 0 3))) | |
65 | ||
66 | (pass-if "5 5" (eq? #f (try-visited? 5 5))) | |
67 | (pass-if "5 7" (eq? #f (try-visited? 5 7))) | |
68 | (pass-if "7 5" (eq? #f (try-visited? 7 5))) | |
69 | (pass-if "7 7" (eq? #f (try-visited? 7 7))) | |
70 | ||
71 | (pass-if "5 5 - 2nd" (eq? #t (try-visited? 5 5))) | |
72 | (pass-if "5 7 - 2nd" (eq? #t (try-visited? 5 7))) | |
73 | (pass-if "7 5 - 2nd" (eq? #t (try-visited? 7 5))) | |
74 | (pass-if "7 7 - 2nd" (eq? #t (try-visited? 7 7))))) |