Heavily revise this test.

- Simplify code
- Remove bogus leftover (tests) in the end
- Resolve deadlock that resulted from using `tcp-abandon-port' in
  `net/ftp'
- Actually there's no need for threads, probably because of small size
  of data, so keep it.
- Use scribble syntax instead of here-strings, and move the text out of
  the way.

original commit: f297c98c1a

collects/tests/net/ftp.rkt

@@ -1,38 +1,62 @@
-#lang racket
+#lang at-exp racket/base
-(require net/ftp tests/eli-tester)
 
-(define (tcp-serve-port cop tp)
+(require net/ftp tests/eli-tester
+         racket/tcp racket/port racket/file racket/match)
+
+(define (tcp-serve dest text)
   (define listener (tcp-listen 0))
-  (define-values (_1 the-port _2 _3) (tcp-addresses listener #t))
+  (define the-port (let-values ([(_1 p _2 _3) (tcp-addresses listener #t)]) p))
-  (values 
+  (define (feed in out)
-   (thread 
+    (if (input-port? in) (copy-port in out) (display in out))
-    (λ ()
+    (flush-output out))
-      (define-values (ip op) (tcp-accept listener))
+  (define (feeder)
-      (define ip->cop-t
+    (define-values [ip op] (tcp-accept listener))
-        (thread (λ ()
+    (for-each thread-wait
-                  (copy-port ip cop))))
+              (list (thread (λ () (feed text op) (close-output-port op)))
-      (define tp->op-t
+                    (thread (λ () (feed ip dest) (close-input-port ip))))))
-        (thread (λ () 
+  (values (thread feeder) the-port))
-                  (copy-port tp op))))
 
-      (thread-wait tp->op-t)
+(define (port->splitstr n)
-      (thread-wait ip->cop-t)
+  (let-values ([(q r) (quotient/remainder n 256)]) (format "~a,~a" q r)))
-      
+(define (tcp-serve* dest text)
-      (flush-output op)
+  (define-values [thd port] (tcp-serve dest text))
-      (flush-output cop)
+  (values thd (port->splitstr port)))
-      
-      (close-output-port op)
-      (close-input-port ip)))
-   the-port))
-
-(define (ftp-port-split n)
-  (quotient/remainder n 256))
 
 (provide tests)
 (define (tests)
   (define cop (open-output-string))
-  (define-values (pasv1-thread pasv1-port)
+  (define-values [pasv1-thd pasv1-port] (tcp-serve* (current-output-port) DIRLIST))
-    (tcp-serve-port (current-output-port) (open-input-string #<<END
+  (define-values [pasv2-thd pasv2-port] (tcp-serve* (current-output-port) TEXT-FILE))
+  (define-values [main-thd main-port] (tcp-serve cop (SERVER-OUTPUT pasv1-port pasv2-port)))
+  (define server "127.0.0.1")
+  (define port main-port)
+  (define user "anonymous")
+  (define passwd "nonny")
+  (define conn #f)
+  (define pth "=README-about-.diff-files")
+  (define tmp-dir (make-temporary-file "racket-ftp-test-~a" 'directory))
+  (test (port->splitstr 18291) => "71,115"
+        (ftp-connection? 1) => #f
+        (set! conn (ftp-establish-connection server port user passwd))
+        (ftp-connection? conn)
+        (when (ftp-connection? conn)
+          (test (ftp-cd conn "gnu")
+                (for ([f (in-list (ftp-directory-list conn))])
+                  (match-define (list* type ftp-date name ?size) f)
+                  (test (ftp-make-file-seconds ftp-date)))
+                (ftp-download-file conn tmp-dir pth)
+                (ftp-close-connection conn)
+                (delete-file (build-path tmp-dir pth))
+                (delete-directory/files tmp-dir)
+                (thread-wait pasv1-thd)
+                (thread-wait pasv2-thd)
+                (thread-wait main-thd)
+                (get-output-string cop) => EXPECTED-USER-OUTPUT
+                ))))
+
+(define S string-append)
+
+(define DIRLIST @S{
   drwxr-xr-x    2 1003     1003         4096 Jan 16  2004 3dldf
   -rw-r--r--    1 1003     65534        1492 Jan 25  2001 =README
   -rw-r--r--    1 1003     65534         745 Mar 20  1997 =README-about-.diff-files
@@ -127,17 +151,14 @@ drwxrwxr-x    2 0        0            4096 Mar 20  2007 flex
   drwxrwxr-x    2 0        1003         4096 Aug 02  2003 fontutils
   drwxr-xr-x    2 1003     1003         4096 Apr 20 21:05 freedink
   drwxrwxr-x    2 0        1003         4096 Jan 04  2009 freefont
-END
+  @||})
-                                                             )))
+
-  (define-values (pasv1-port-maj pasv1-port-min)
+(define TEXT-FILE @S{
-    (ftp-port-split pasv1-port))
+  1. Sometimes diffs between two versions were either too large to be
-  (define-values (pasv2-thread pasv2-port)
-    (tcp-serve-port (current-output-port) (open-input-string #<<END
-1) Sometimes diffs between two versions were either too large to be
   worth making, or too difficult.  In those cases where a .diff file is
   missing, please just FTP the latest version.
 
-2) The .diff file suffix signifies a patch file produced by the GNU
+  2. The .diff file suffix signifies a patch file produced by the GNU
   'diff' program.
 
   A diff file like this has all of the changes from one version of a
@@ -149,17 +170,13 @@ You can use the "patch" program to apply the diff to your sources.
   /pub/gnu/ if it isn't already installed on your system.)
 
   (You might also want to take a look at the diff file, the format is
-pretty obvious and could be educational. ;-)
+  pretty obvious and could be educational. :-)
 
   Thank You!
+  @||})
 
-END
+(define (SERVER-OUTPUT pasv1-port pasv2-port)
-                                                             )))
+  @S{220 GNU FTP server ready.
-  (define-values (pasv2-port-maj pasv2-port-min)
-    (ftp-port-split pasv2-port))
-  (define-values (main-thread main-port)
-    (tcp-serve-port cop (open-input-string (format #<<END
-220 GNU FTP server ready.
      230-Due to U.S. Export Regulations, all cryptographic software on this
      230-site is subject to the following legal notice:
      230-
@@ -194,53 +211,19 @@ END
      250-system. See:
      250-http://www.gnu.org/philosophy/categories.html#TheGNUsystem
      250 Directory successfully changed.
-227 Entering Passive Mode (127,0,0,1,~a,~a)
+     227 Entering Passive Mode (127,0,0,1,@pasv1-port)
      200 Switching to Binary mode.
      150 Here comes the directory listing.
      226 Directory send OK.
-227 Entering Passive Mode (127,0,0,1,~a,~a)
+     227 Entering Passive Mode (127,0,0,1,@pasv2-port)
      200 Switching to Binary mode.
      150 Opening BINARY mode data connection for =README-about-.diff-files (745 bytes).
      226 File send OK.
      221 Goodbye.
+     @||})
 
-END
+(define EXPECTED-USER-OUTPUT
-                                                   pasv1-port-maj pasv1-port-min
+  @(lambda xs (regexp-replace* #rx"\n" (apply S xs) "\r\n")){
-                                                   pasv2-port-maj pasv2-port-min
-                                                   ))))
-  
-  (define server "127.0.0.1")
-  (define port main-port)
-  (define user "anonymous")
-  (define passwd "nonny")
-  (define conn #f)
-  (define pth "=README-about-.diff-files")
-  (define tmp-dir (make-temporary-file "ftp~a" 'directory))
-  (test (ftp-port-split 18291) => (values 71 115)
-        (ftp-connection? 1) => #f
-        (set! conn (ftp-establish-connection server port user passwd))
-        (ftp-connection? conn)
-        (when (ftp-connection? conn)
-          (test
-           (ftp-cd conn "gnu")
-           (for ([f (in-list (ftp-directory-list conn))])
-             (match-define (list type ftp-date name) f)
-             (test
-              (ftp-make-file-seconds ftp-date)))
-           
-           (ftp-download-file conn tmp-dir pth)
-           
-           (ftp-close-connection conn)
-           
-           (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
      CWD gnu
      PASV
@@ -250,9 +233,4 @@ PASV
      TYPE I
      RETR =README-about-.diff-files
      QUIT
-
+     @||})
-END
-           
-           ))))
-
-(tests)