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

Increasing FTP test stability

Browse Source 
original commit: bc15f398f2
This commit is contained in:
Jay McCarthy 2010-08-28 18:52:29 -06:00
parent 58ec991bd1
commit 21c34d29d4
1 changed files with 43 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
collects/tests/net/ftp.rkt
View File

@ -8,13 +8,21 @@
(thread (thread
(λ () (λ ()
(define-values (ip op) (tcp-accept listener)) (define-values (ip op) (tcp-accept listener))
(thread (λ () (define ip->cop-t
(copy-port ip cop) (thread (λ ()
(flush-output cop) (copy-port ip cop))))
(close-input-port ip))) (define tp->op-t
(thread (λ () (thread (λ ()
(copy-port tp op) (copy-port tp op))))
(close-output-port op)))))
(thread-wait tp->op-t)
(thread-wait ip->cop-t)
(flush-output op)
(flush-output cop)
(close-output-port op)
(close-input-port ip)))
the-port)) the-port))
(define (ftp-port-split n) (define (ftp-port-split n)
@ -120,7 +128,7 @@ drwxrwxr-x 2 0 1003 4096 Aug 02 2003 fontutils
drwxr-xr-x 2 1003 1003 4096 Apr 20 21:05 freedink drwxr-xr-x 2 1003 1003 4096 Apr 20 21:05 freedink
drwxrwxr-x 2 0 1003 4096 Jan 04 2009 freefont drwxrwxr-x 2 0 1003 4096 Jan 04 2009 freefont
END END
))) )))
(define-values (pasv1-port-maj pasv1-port-min) (define-values (pasv1-port-maj pasv1-port-min)
(ftp-port-split pasv1-port)) (ftp-port-split pasv1-port))
(define-values (pasv2-thread pasv2-port) (define-values (pasv2-thread pasv2-port)
@ -146,7 +154,7 @@ pretty obvious and could be educational. ;-)
Thank You! Thank You!
END END
))) )))
(define-values (pasv2-port-maj pasv2-port-min) (define-values (pasv2-port-maj pasv2-port-min)
(ftp-port-split pasv2-port)) (ftp-port-split pasv2-port))
(define-values (main-thread main-port) (define-values (main-thread main-port)
@ -197,9 +205,9 @@ END
221 Goodbye. 221 Goodbye.
END END
pasv1-port-maj pasv1-port-min pasv1-port-maj pasv1-port-min
pasv2-port-maj pasv2-port-min pasv2-port-maj pasv2-port-min
)))) ))))
(define server "localhost") (define server "localhost")
(define port main-port) (define port main-port)
@ -212,21 +220,27 @@ END
(ftp-connection? 1) => #f (ftp-connection? 1) => #f
(set! conn (ftp-establish-connection server port user passwd)) (set! conn (ftp-establish-connection server port user passwd))
(ftp-connection? conn) (ftp-connection? conn)
(ftp-cd conn "gnu") (when (ftp-connection? conn)
(for ([f (in-list (ftp-directory-list conn))])
(match-define (list type ftp-date name) f)
(test (test
(ftp-make-file-seconds ftp-date))) (ftp-cd conn "gnu")
(for ([f (in-list (ftp-directory-list conn))])
(ftp-download-file conn tmp-dir pth) (match-define (list type ftp-date name) f)
(test
(ftp-close-connection conn) (ftp-make-file-seconds ftp-date)))
(delete-file (build-path tmp-dir pth)) (ftp-download-file conn tmp-dir pth)
(delete-directory/files tmp-dir)
(ftp-close-connection conn)
(get-output-string cop) =>
#<<END (delete-file (build-path tmp-dir pth))
(delete-directory/files tmp-dir)
(thread-wait pasv1-thread)
(thread-wait pasv2-thread)
(thread-wait main-thread)
(get-output-string cop) =>
#<<END
USER anonymous USER anonymous
CWD gnu CWD gnu
PASV PASV
@ -235,9 +249,10 @@ LIST
PASV PASV
TYPE I TYPE I
RETR =README-about-.diff-files RETR =README-about-.diff-files
QUIT
END END
)) ))))
(tests) (tests)