← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/ftw.test

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
test-suite/tests/ftw.test
 
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
 
8
;;;; version 2.1 of the License, or (at your option) any later version.
 
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
 
 
28
(or (equal? (procedure-source stat:dev)
 
29
            '(lambda (f) (vector-ref f 0)))
 
30
    (error "oops, unexpected stat:dev definition"))
 
31
(define (stat:dev! st dev)
 
32
  (vector-set! st 0 dev))
 
33
 
 
34
(or (equal? (procedure-source stat:ino)
 
35
            '(lambda (f) (vector-ref f 1)))
 
36
    (error "oops, unexpected stat:ino definition"))
 
37
(define (stat:ino! st ino)
 
38
  (vector-set! st 1 ino))
 
39
 
 
40
 
 
41
;;
 
42
;; visited?-proc
 
43
;;
 
44
 
 
45
(with-test-prefix "visited?-proc"
 
46
 
 
47
  ;; normally internal-only
 
48
  (let* ((visited?-proc (@@ (ice-9 ftw) visited?-proc))
 
49
         (visited? (visited?-proc 97))
 
50
         (s (stat "/")))
 
51
 
 
52
    (define (try-visited? dev ino)
 
53
      (stat:dev! s dev)
 
54
      (stat:ino! s ino)
 
55
      (visited? s))
 
56
 
 
57
    (pass-if "0 0 - 1st" (eq? #f (try-visited? 0 0)))
 
58
    (pass-if "0 0 - 2nd" (eq? #t (try-visited? 0 0)))
 
59
    (pass-if "0 0 - 3rd" (eq? #t (try-visited? 0 0)))
 
60
 
 
61
    (pass-if "0 1" (eq? #f (try-visited? 0 1)))
 
62
    (pass-if "0 2" (eq? #f (try-visited? 0 2)))
 
63
    (pass-if "0 3" (eq? #f (try-visited? 0 3)))
 
64
 
 
65
    (pass-if "5 5" (eq? #f (try-visited? 5 5)))
 
66
    (pass-if "5 7" (eq? #f (try-visited? 5 7)))
 
67
    (pass-if "7 5" (eq? #f (try-visited? 7 5)))
 
68
    (pass-if "7 7" (eq? #f (try-visited? 7 7)))
 
69
 
 
70
    (pass-if "5 5 - 2nd" (eq? #t (try-visited? 5 5)))
 
71
    (pass-if "5 7 - 2nd" (eq? #t (try-visited? 5 7)))
 
72
    (pass-if "7 5 - 2nd" (eq? #t (try-visited? 7 5)))
 
73
    (pass-if "7 7 - 2nd" (eq? #t (try-visited? 7 7)))))