suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Improve `file' tests.

Browse Source 
* Move sha1 test to the same place, to be run like the others.

* Unify tests for untar and unzip.

* Also improve them: test results instead of failing with errors.  Also,
  generate random text to archive, and use 0 for group+other permission
  bits (to avoid world writable results on an error).
This commit is contained in:
Eli Barzilay 2013-02-24 05:20:34 -05:00
parent cae6b53178
commit c7173cd1c6
6 changed files with 176 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/file/tests/sha1.rkt
View File

@ -1,9 +0,0 @@
#lang racket/base
(require file/sha1 rackunit)
;; The docs say that sha1 must return a 40-character string,
;; and should include leading zeros.
(check-equal? (string-length (sha1 (open-input-string " r a c k et")))
40)

8
collects/tests/file/main.rkt
View File

@ -2,10 +2,14 @@
(require tests/eli-tester
(prefix-in gzip: "gzip.rkt")
(prefix-in md5: "md5.rkt"))
(prefix-in md5: "md5.rkt")
(prefix-in sha1: "sha1.rkt")
(prefix-in unpackers: "unpackers.rkt"))
(define (tests)
(test do (gzip:tests)
do (md5:tests)))
do (md5:tests)
do (sha1:tests)
do (unpackers:tests)))
(tests)

12
collects/tests/file/sha1.rkt Normal file
View File

@ -0,0 +1,12 @@
#lang racket/base
(require file/sha1 tests/eli-tester)
(provide tests)
(module+ main (tests))
(define (tests)
(test
;; The docs say that sha1 must return a 40-character string,
;; and should include leading zeros.
(string-length (sha1 (open-input-string ""))) => 40
(string-length (sha1 (open-input-string " r a c k et"))) => 40))

158
collects/tests/file/unpackers.rkt Normal file
View File

@ -0,0 +1,158 @@
#lang racket/base
(require file/untar file/untgz file/unzip racket/file racket/system
tests/eli-tester)
(provide tests)
(define tmp (find-system-path 'temp-dir))
(define tar-exe (find-executable-path "tar"))
(define gzip-exe (find-executable-path "gzip"))
(define zip-exe (find-executable-path "zip"))
(define work-dir (build-path tmp (format "unpacker-testing~a" (random 1000))))
(define a.tar (build-path work-dir "a.tar"))
(define a.zip (build-path work-dir "a.zip"))
(define ex1-dir (build-path work-dir "ex1"))
(define more-dir (build-path ex1-dir "more"))
(define (file-or-directory-permissions* path permissions)
(file-or-directory-permissions
path
(for/fold ([n 0]) ([p '(["r" #o400] ["w" #o200] ["x" #o100])])
(if (regexp-match? (car p) permissions) (bitwise-ior n (cadr p)) n))))
(define (make-file path [mod-time #f] [permissions #f])
(with-output-to-file path
(lambda ()
(for ([i (in-range (random 1000))])
(write-bytes (make-bytes (random 100) (+ 32 (random 96)))))))
(when mod-time (file-or-directory-modify-seconds path mod-time))
(when permissions (file-or-directory-permissions* path permissions)))
(define ((make-packer pack . flags) dir dest)
(define-values [base name dir?] (split-path dir))
(parameterize ([current-directory
(if (eq? 'relative base) (current-directory) base)])
(void (apply system* pack `(,@flags ,dest ,name)))))
(define tar (make-packer tar-exe "-c" "-f"))
(define zip (make-packer zip-exe "-r" "-q"))
(define (diff src dest check-attributes?)
(define (compare-attributes p1 p2)
(or (not check-attributes?)
(and (= (file-or-directory-modify-seconds p1)
(file-or-directory-modify-seconds p2))
(equal? (file-or-directory-permissions p1)
(file-or-directory-permissions p2)))))
(cond
[(link-exists? src)
(and (link-exists? dest)
(diff (resolve-path src) (resolve-path dest) check-attributes?))]
[(file-exists? src)
(and (file-exists? dest)
(= (file-size src) (file-size dest))
(compare-attributes src dest)
(equal? (file->bytes src) (file->bytes dest)))]
[(directory-exists? src)
(and (directory-exists? dest)
(compare-attributes src dest)
(let* ([sort-paths (λ (l) (sort l bytes<? #:key path->bytes))]
[srcs (sort-paths (directory-list src))]
[dests (sort-paths (directory-list dest))])
(and (equal? srcs dests)
(for/and ([src-item (in-list srcs)]
[dest-item (in-list dests)])
(diff (build-path src src-item)
(build-path dest dest-item)
check-attributes?))
;; make dest writable to simplify clean-up:
(begin (file-or-directory-permissions* dest "rwx") #t))))]
[else #t]))
(define (untar-tests*)
(make-directory* "ex1")
(make-file (build-path "ex1" "f1") (- (current-seconds) 12) "rw")
(make-file (build-path "ex1" "f2") (+ (current-seconds) 12) "rwx")
(make-file (build-path "ex1" "f3") (- (current-seconds) 7) "r")
(make-file-or-directory-link "fnone" (build-path "ex1" "f4"))
(make-directory* more-dir)
(make-file (build-path more-dir "f4") (current-seconds) "rw")
(file-or-directory-permissions* more-dir "rx") ; not "w"
(tar "ex1" a.tar)
(make-directory* "sub")
(parameterize ([current-directory "sub"]) (untar a.tar))
(test (diff "ex1" (build-path "sub" "ex1") #t))
(delete-directory/files "sub")
(untar a.tar #:dest "sub")
(test (diff "ex1" (build-path "sub" "ex1") #t))
(delete-directory/files "sub")
(untgz a.tar #:dest "sub")
(test (diff "ex1" (build-path "sub" "ex1") #t))
(delete-directory/files "sub")
(untar a.tar #:dest "sub" #:filter (lambda args #f))
(when (directory-exists? "sub") (error "should not have been unpacked"))
(void (system* gzip-exe a.tar))
(untgz (path-replace-suffix a.tar #".tar.gz") #:dest "sub")
(test (diff "ex1" (build-path "sub" "ex1") #t))
(delete-directory/files "sub")
(file-or-directory-permissions* more-dir "rwx"))
(define (unzip-tests*)
(make-directory* "ex1")
(make-file (build-path "ex1" "f1"))
(make-file (build-path "ex1" "f2"))
(make-file (build-path "ex1" "f3"))
(make-directory* more-dir)
(make-file (build-path more-dir "f4"))
(zip "ex1" a.zip)
(make-directory* "sub")
(parameterize ([current-directory "sub"]) (unzip a.zip))
(diff "ex1" (build-path "sub" "ex1") #f)
(delete-directory/files "sub")
(unzip a.zip (make-filesystem-entry-reader #:dest "sub"))
(diff "ex1" (build-path "sub" "ex1") #f)
(delete-directory/files "sub")
(unzip a.zip (lambda (bytes dir? in) (void)))
(when (directory-exists? "sub") (error "should not have been unpacked"))
(define (directory-test src)
(define zd (read-zip-directory src))
(test (zip-directory? zd)
(zip-directory-contains? zd "ex1/f1")
(zip-directory-contains? zd #"ex1/f1")
(zip-directory-contains? zd "ex1/more/f4")
(zip-directory-contains? zd (string->path "ex1/more/f4"))
(zip-directory-includes-directory? zd "ex1/more"))
(define (check-not-there p)
(test (not (zip-directory-contains? zd p)))
(with-handlers ([exn:fail:unzip:no-such-entry?
(lambda (exn)
(test (exn:fail:unzip:no-such-entry-entry exn)
=> (if (bytes? p) p (path->zip-path p))))])
(unzip-entry src zd p)))
(check-not-there #"f1")
(for ([entry (in-list (zip-directory-entries zd))])
(parameterize ([current-directory work-dir])
(unzip-entry src zd entry (make-filesystem-entry-reader #:dest "sub"))))
(diff "ex1" (build-path "sub" "ex1") #f)
(delete-directory/files "sub"))
(directory-test a.zip)
(call-with-input-file a.zip directory-test))
(define (run-tests tester)
(define (cleanup)
(when (directory-exists? work-dir) (delete-directory/files work-dir)))
(dynamic-wind
cleanup
(λ () (make-directory work-dir)
(parameterize ([current-directory work-dir])
(test do (tester))))
cleanup))
(define (untar-tests) (test do (run-tests untar-tests*)))
(define (unzip-tests) (test do (run-tests unzip-tests*)))
(module+ main (tests))
(define (tests)
(test do (untar-tests)
do (unzip-tests)))

122
collects/tests/file/untar.rkt
View File

@ -1,122 +0,0 @@
#lang racket/base
(require file/untar
file/untgz
racket/file
racket/system)
(define tmp (find-system-path 'temp-dir))
(define tar-exe (find-executable-path "tar"))
(define gzip-exe (find-executable-path "gzip"))
(define work-dir (build-path tmp (format "untar-testing~a" (random 1000))))
(printf "Working in ~a\n" work-dir)
(when (directory-exists? work-dir)
(delete-directory/files work-dir))
(define a.tar (build-path work-dir "a.tar"))
(define sub-dir (build-path work-dir "sub"))
(define (make-file path mod-time [permissions '(read write)])
(with-output-to-file path
(lambda ()
(write-bytes (make-bytes (random 100000)))))
(file-or-directory-modify-seconds path mod-time)
(file-or-directory-permissions* path permissions))
(define (file-or-directory-permissions* path permissions)
(file-or-directory-permissions path
(bitwise-ior
(if (memq 'read permissions)
#o444
0)
(if (memq 'write permissions)
#o222
0)
(if (memq 'execute permissions)
#o111
0))))
(define ex1-dir (build-path work-dir "ex1"))
(make-directory* ex1-dir)
(make-file (build-path ex1-dir "f1") (- (current-seconds) 12))
(make-file (build-path ex1-dir "f2") (+ (current-seconds) 12) '(read write execute))
(make-file (build-path ex1-dir "f3") (- (current-seconds) 7) '(read))
(make-file-or-directory-link "fnone" (build-path ex1-dir "f4"))
(define more-dir (build-path ex1-dir "more"))
(make-directory* more-dir)
(make-file (build-path more-dir "f4") (current-seconds))
(file-or-directory-permissions* more-dir '(read execute)) ; not 'write
(define (tar dir)
(define-values (base name dir?) (split-path dir))
(parameterize ([current-directory base])
(void (system* tar-exe "-c" "-f" a.tar name))))
(define (diff-error src dest)
(error 'diff "different: ~e ~e\n" src dest))
(define (diff src dest)
(cond
[(link-exists? src)
(unless (link-exists? dest) (diff-error src dest))
(diff (resolve-path src) (resolve-path dest))]
[(file-exists? src)
(unless (and (file-exists? dest)
(= (file-size src) (file-size dest))
(= (file-or-directory-modify-seconds src)
(file-or-directory-modify-seconds dest))
(equal? (file-or-directory-permissions src)
(file-or-directory-permissions dest))
(equal? (file->bytes src) (file->bytes dest)))
(diff-error src dest))]
[(directory-exists? src)
(unless (and (directory-exists? dest)
(= (file-or-directory-modify-seconds src)
(file-or-directory-modify-seconds dest))
(equal? (file-or-directory-permissions src)
(file-or-directory-permissions dest)))
(diff-error src dest))
(define (sort-paths l)
(sort l bytes<? #:key path->bytes))
(define srcs (sort-paths (directory-list src)))
(define dests (sort-paths (directory-list dest)))
(unless (equal? srcs dests) (diff-error src dest))
(for ([src-item (in-list srcs)]
[dest-item (in-list dests)])
(diff (build-path src src-item) (build-path dest dest-item)))
;; make dest writable to simplify clean-up:
(file-or-directory-permissions* dest '(read execute write))]
[else (void)]))
(tar ex1-dir)
(make-directory* sub-dir)
(parameterize ([current-directory sub-dir])
(untar a.tar))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir)
(parameterize ([current-directory work-dir])
(untar a.tar #:dest "sub"))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir)
(parameterize ([current-directory work-dir])
(untgz a.tar #:dest "sub"))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir)
(parameterize ([current-directory work-dir])
(untar a.tar #:dest "sub" #:filter (lambda args #f)))
(when (directory-exists? sub-dir)
(error "should not have been unpacked"))
(void (system* gzip-exe a.tar))
(parameterize ([current-directory work-dir])
(untgz (path-replace-suffix a.tar #".tar.gz") #:dest "sub"))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir)
(file-or-directory-permissions* more-dir '(read execute write))
(delete-directory/files work-dir)

118
collects/tests/file/unzip.rkt
View File

@ -1,118 +0,0 @@
#lang racket/base
(require file/unzip
racket/file
racket/system)
(define tmp (find-system-path 'temp-dir))
(define zip-exe (find-executable-path "zip"))
(define work-dir (build-path tmp (format "unzip-testing~a" (random 1000))))
(printf "Working in ~a\n" work-dir)
(when (directory-exists? work-dir)
(delete-directory/files work-dir))
(define a.zip (build-path work-dir "a.zip"))
(define sub-dir (build-path work-dir "sub"))
(define (make-file path)
(with-output-to-file path
(lambda ()
(write-bytes (make-bytes (random 100000) 42))))
(void))
(define ex1-dir (build-path work-dir "ex1"))
(define more-dir (build-path ex1-dir "more"))
(make-directory* ex1-dir)
(make-file (build-path ex1-dir "f1"))
(make-file (build-path ex1-dir "f2"))
(make-file (build-path ex1-dir "f3"))
(make-directory* more-dir)
(make-file (build-path more-dir "f4"))
(define (zip dir)
(define-values (base name dir?) (split-path dir))
(parameterize ([current-directory base])
(void (system* zip-exe "-r" a.zip name))))
(define (diff-error src dest)
(error 'diff "different: ~e ~e\n" src dest))
(define (diff src dest)
(cond
[(link-exists? src)
(unless (link-exists? dest) (diff-error src dest))
(diff (resolve-path src) (resolve-path dest))]
[(file-exists? src)
(unless (and (file-exists? dest)
(= (file-size src) (file-size dest))
(equal? (file->bytes src) (file->bytes dest)))
(diff-error src dest))]
[(directory-exists? src)
(unless (directory-exists? dest)
(diff-error src dest))
(define (sort-paths l)
(sort l bytes<? #:key path->bytes))
(define srcs (sort-paths (directory-list src)))
(define dests (sort-paths (directory-list dest)))
(unless (equal? srcs dests) (diff-error src dest))
(for ([src-item (in-list srcs)]
[dest-item (in-list dests)])
(diff (build-path src src-item) (build-path dest dest-item)))]
[else (void)]))
(zip ex1-dir)
(make-directory* sub-dir)
(parameterize ([current-directory sub-dir])
(unzip a.zip))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir)
(parameterize ([current-directory work-dir])
(unzip a.zip (make-filesystem-entry-reader #:dest "sub")))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir)
(parameterize ([current-directory work-dir])
(unzip a.zip (lambda (bytes dir? in) (void))))
(when (directory-exists? sub-dir)
(error "should not have been unpacked"))
(define (directory-test src)
(define zd (read-zip-directory src))
(unless (zip-directory? zd)
(error "not a zip directory"))
(define (check-there p)
(unless (zip-directory-contains? zd p)
(error 'unzip-test "not there: ~e" p)))
(check-there "ex1/f1")
(check-there #"ex1/f1")
(check-there "ex1/more/f4")
(check-there (string->path "ex1/more/f4"))
(unless (zip-directory-includes-directory? zd "ex1/more")
(error "directory missing"))
(define (check-not-there p)
(when (zip-directory-contains? zd p)
(error "there!"))
(with-handlers ([exn:fail:unzip:no-such-entry?
(lambda (exn)
(unless (equal? (exn:fail:unzip:no-such-entry-entry exn)
(if (bytes? p)
p
(path->zip-path p)))
(error "bad exn")))])
(unzip-entry src zd p)))
(check-not-there #"f1")
(for ([entry (in-list (zip-directory-entries zd))])
(parameterize ([current-directory work-dir])
(unzip-entry src zd entry
(make-filesystem-entry-reader #:dest "sub"))))
(diff ex1-dir (build-path sub-dir "ex1"))
(delete-directory/files sub-dir))
(directory-test a.zip)
(call-with-input-file a.zip
directory-test)
(delete-directory/files work-dir)