source: project/release/4/hfs+/trunk/test.scm @ 15278

Last change on this file since 15278 was 15278, checked in by Jim Ursetto, 12 years ago

hfs+: update to version 0.3 (copyfile)

File size: 5.5 KB
Line 
1;;; test hfs+ interface
2
3(use test)
4(use hfs+)
5(use files)
6(use posix)
7
8;; Assumes UNIX files are created with no attributes.
9;; Untested: Finder info.  Removing resource forks
10;; (must set to "").
11
12(test-group
13 "extended-attribute handling"
14
15 (define file (create-temporary-file "hfs-test"))
16 (define link (string-append file ".link")) ; meh
17
18 (test "empty initial attribute set"
19       '()
20       (list-extended-attributes file))
21
22;; (set-extended-attribute! file "com.apple.FinderInfo" (make-string 32 #\x00))
23 (set-extended-attribute! file "chicken.baz" "quux")
24 (set-extended-attribute! file "chicken.zot" "erp")
25 (set-extended-attribute! file "chicken.foo" "bar")
26
27 (test "list three attributes in chicken namespace"
28       '("chicken.baz" "chicken.foo" "chicken.zot")
29       (sort (list-extended-attributes file) string<?))
30 (test "get three attributes in chicken namespace"
31       '("quux" "erp" "bar")
32       (list (get-extended-attribute file "chicken.baz")
33             (get-extended-attribute file "chicken.zot")
34             (get-extended-attribute file "chicken.foo")))
35
36 (test "replace existing attribute"
37       #t
38       (begin
39         (set-extended-attribute! file "chicken.foo" "bar-updated" #:replace)
40         #t))
41 (test-error "replace non-existent attribute (error)"
42             (set-extended-attribute! file "chicken.foo" "bar-updated" #:update))
43 (test "create non-existent attribute ok"
44       #t
45       (begin
46         (set-extended-attribute! file "chicken.new" "new" #:create)
47         #t))
48 (test-error "create existing attribute (error)"
49             (set-extended-attribute! file "chicken.new" "new" #:create))
50
51 (remove-extended-attribute! file "chicken.foo")
52 (test "three attributes after one removed"
53       '("chicken.baz" "chicken.new" "chicken.zot")
54       (sort (list-extended-attributes file) string<?))
55
56 (create-symbolic-link file link)
57 (set-extended-attribute! link "chicken.link" "nugget" #:no-follow)
58 (test "get attributes, following link"
59       (list "quux" #f)
60       (list (get-extended-attribute link "chicken.baz")
61             (get-extended-attribute link "chicken.link")))
62 (test "get attributes, on link itself"
63       (list #f "nugget")
64       (list (get-extended-attribute link "chicken.baz"  #:no-follow)
65             (get-extended-attribute link "chicken.link" #:no-follow)))
66
67 (for-each (lambda (x)
68             (remove-extended-attribute! file x))
69           (list-extended-attributes file))
70 (test "remove remaining attributes"
71       '()
72       (sort (list-extended-attributes file) string<?))
73
74 (test-error "remove non-existent attribute (error)"
75             (remove-extended-attribute! file "chicken.baz"))
76
77 (delete-file file)
78 (delete-file link))
79
80;;; copyfile
81
82(test-group
83 "copyfile"
84
85;; Untested: ACL preservation
86;; Can't test on Tiger: copyfile data->data ; will segfault
87
88 (set! file (create-temporary-file "hfs-test"))
89 (set! link (string-append file ".link")) ; meh
90 (set! unpacked-file (create-temporary-file "hfs-test"))
91 (define packed-file (string-append "._" file))
92 (define packed-link (string-append "._" link))
93 (set! unpacked-link-file (create-temporary-file "hfs-test"))
94 (set! unpacked-link (string-append unpacked-link-file ".link")) 
95
96 (test (string-append "set extended attributes on " file)
97       #t
98       (begin
99         (set-extended-attribute! file "com.apple.ResourceFork" "spoon!")
100         (set-extended-attribute! file "org.3e8.private" "eye")
101         #t))
102 (test (string-append "pack " file " to appledouble " packed-file)
103       #t
104       (pack-appledouble file packed-file))
105 (test (string-append "unpack " file " to " unpacked-file)
106       #t
107       (unpack-appledouble packed-file unpacked-file))
108 (test (string-append "recover resource fork from " unpacked-file)
109       "spoon!"
110       (get-extended-attribute unpacked-file "com.apple.ResourceFork"))
111 (test (string-append "recover private attribute from " unpacked-file)
112       "eye"
113       (get-extended-attribute unpacked-file "org.3e8.private"))
114
115 (test (string-append "check attributes on " unpacked-file)
116       '(xattr)
117       (copyfile-check unpacked-file #:metadata))
118
119 ;; Attempt to copy attributes from a symbolic link to another symbolic link.
120 ;; This will fail on 10.4, which does not honor no-follow on unpack/pack.
121 ;; Set attributes on the links and backing files beforehand so we can
122 ;; see what propagates through.
123 (create-symbolic-link file link)
124 (create-symbolic-link unpacked-link-file unpacked-link)
125 (set-extended-attribute! link "org.3e8.private" "file")
126 (set-extended-attribute! link "org.3e8.private" "link" #:no-follow)
127 (set-extended-attribute! unpacked-link "org.3e8.private"
128                          "unpacked-link" #:no-follow)
129 (set-extended-attribute! unpacked-link-file "org.3e8.private"
130                          "unpacked-link-file" #:no-follow)
131 (pack-appledouble link packed-link #:no-follow)
132 (unpack-appledouble packed-link unpacked-link #:no-follow)
133 (test (string-append "recover private attribute from symlink (fails on 10.4)")
134       "link"
135       (get-extended-attribute unpacked-link "org.3e8.private" #:no-follow))
136 (test (string-append "recover private attribute from backing file (fails on 10.4)")
137       "unpacked-link-file"
138       (get-extended-attribute link "org.3e8.private"))
139 
140 (delete-file file)
141 (delete-file link)
142 (delete-file unpacked-file)
143 (delete-file unpacked-link)
144 (delete-file unpacked-link-file) 
145 (delete-file packed-file)
146 (delete-file packed-link))
147
148(test-group
149 "unimplemented or untested"
150 (test (string-append "copyfile #:data")
151       0
152       (error "cannot test data->data copyfile on Tiger, may segfault")))
153
154;;; further tests go here
Note: See TracBrowser for help on using the repository browser.