parent
e6fc4d4027
commit
c276d448fe
|
@ -1,7 +1,5 @@
|
|||
(module cgi mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"cgi-sig.ss"
|
||||
"cgi-unit.ss")
|
||||
(require (lib "unit.ss") "cgi-sig.ss" "cgi-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer cgi@)
|
||||
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module cookie mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"cookie-sig.ss"
|
||||
"cookie-unit.ss")
|
||||
(require (lib "unit.ss") "cookie-sig.ss" "cookie-unit.ss")
|
||||
|
||||
(provide-signature-elements cookie^)
|
||||
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module dns mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"dns-sig.ss"
|
||||
"dns-unit.ss")
|
||||
(require (lib "unit.ss") "dns-sig.ss" "dns-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer dns@)
|
||||
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module ftp mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"ftp-sig.ss"
|
||||
"ftp-unit.ss")
|
||||
(require (lib "unit.ss") "ftp-sig.ss" "ftp-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer ftp@)
|
||||
|
||||
|
|
|
@ -1,8 +1,5 @@
|
|||
(module imap mzscheme
|
||||
(require (lib "unit.ss")
|
||||
(lib "contract.ss")
|
||||
"imap-sig.ss"
|
||||
"imap-unit.ss")
|
||||
(require (lib "unit.ss") (lib "contract.ss") "imap-sig.ss" "imap-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer imap@)
|
||||
|
||||
|
|
|
@ -40,18 +40,18 @@
|
|||
;; that has character c
|
||||
(define string-index
|
||||
(lambda (s c)
|
||||
(let ((n (string-length s)))
|
||||
(let loop ((i 0))
|
||||
(cond ((>= i n) #f)
|
||||
((char=? (string-ref s i) c) i)
|
||||
(else (loop (+ i 1))))))))
|
||||
(let ([n (string-length s)])
|
||||
(let loop ([i 0])
|
||||
(cond [(>= i n) #f]
|
||||
[(char=? (string-ref s i) c) i]
|
||||
[else (loop (+ i 1))])))))
|
||||
|
||||
;; string-tokenizer breaks string s into substrings separated by character c
|
||||
(define string-tokenizer
|
||||
(lambda (c s)
|
||||
(let loop ((s s))
|
||||
(let loop ([s s])
|
||||
(if (string=? s "") '()
|
||||
(let ((i (string-index s c)))
|
||||
(let ([i (string-index s c)])
|
||||
(if i (cons (substring s 0 i)
|
||||
(loop (substring s (+ i 1)
|
||||
(string-length s))))
|
||||
|
@ -108,7 +108,7 @@
|
|||
(define re:comments (regexp "^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))"))
|
||||
(define trim-comments
|
||||
(lambda (str)
|
||||
(let* ((positions (regexp-match-positions re:comments str)))
|
||||
(let ([positions (regexp-match-positions re:comments str)])
|
||||
(if positions
|
||||
(string-append (substring str 0 (caaddr positions))
|
||||
(substring str (cdaddr positions) (string-length str)))
|
||||
|
@ -116,31 +116,33 @@
|
|||
|
||||
(define lowercase
|
||||
(lambda (str)
|
||||
(let loop ((out "") (rest str) (size (string-length str)))
|
||||
(cond ((zero? size) out)
|
||||
(else
|
||||
(let loop ([out ""] [rest str] [size (string-length str)])
|
||||
(cond [(zero? size) out]
|
||||
[else
|
||||
(loop (string-append out (string
|
||||
(char-downcase
|
||||
(string-ref rest 0))))
|
||||
(substring rest 1 size)
|
||||
(sub1 size)))))))
|
||||
(sub1 size))]))))
|
||||
|
||||
(define warning void)
|
||||
#|
|
||||
(define warning
|
||||
void
|
||||
#;
|
||||
(lambda (msg . args)
|
||||
(fprintf (current-error-port)
|
||||
(apply format (cons msg args)))
|
||||
(newline (current-error-port))))
|
||||
|#
|
||||
(newline (current-error-port)))
|
||||
)
|
||||
|
||||
;; Copies its input `in' to its ouput port if given, it uses
|
||||
;; current-output-port if out is not provided.
|
||||
(define cat
|
||||
(opt-lambda (in (out (current-output-port)))
|
||||
(let loop ((ln (read-line in)))
|
||||
(let loop ([ln (read-line in)])
|
||||
(unless (eof-object? ln)
|
||||
(fprintf out "~a~n" ln)
|
||||
(fprintf out "~a\n" ln)
|
||||
(loop (read-line in))))))
|
||||
|
||||
)
|
||||
|
||||
;;; mime-util.ss ends here
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module nntp mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"nntp-sig.ss"
|
||||
"nntp-unit.ss")
|
||||
(require (lib "unit.ss") "nntp-sig.ss" "nntp-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer nntp@)
|
||||
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module pop3 mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"pop3-sig.ss"
|
||||
"pop3-unit.ss")
|
||||
(require (lib "unit.ss") "pop3-sig.ss" "pop3-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer pop3@)
|
||||
|
||||
|
@ -29,5 +27,4 @@
|
|||
"Status: RO")
|
||||
("some body" "text" "goes" "." "here" "." "")
|
||||
> (disconnect-from-server c)
|
||||
|
||||
|#
|
||||
|
|
|
@ -321,7 +321,7 @@ Tests:
|
|||
[(< n 0) (fetch-delete! t (- n))]
|
||||
[(inexact? n) (fetch-shift! t (inexact->exact n))]
|
||||
[else (fetch-insert! t (list n))])
|
||||
(printf "Check ~a~n" v)
|
||||
(printf "Check ~a\n" v)
|
||||
(let ([v (map list v)])
|
||||
(unless (equal? (fetch-tree->list t) v)
|
||||
(error 'bad "~s != ~s" (fetch-tree->list t) v))))
|
||||
|
|
|
@ -26,9 +26,7 @@
|
|||
;; Commentary:
|
||||
|
||||
(module qp mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"qp-sig.ss"
|
||||
"qp-unit.ss")
|
||||
(require (lib "unit.ss") "qp-sig.ss" "qp-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer qp@)
|
||||
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module sendmail mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"sendmail-sig.ss"
|
||||
"sendmail-unit.ss")
|
||||
(require (lib "unit.ss") "sendmail-sig.ss" "sendmail-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer sendmail@)
|
||||
|
||||
|
|
|
@ -1,7 +1,5 @@
|
|||
(module smtp mzscheme
|
||||
(require (lib "unit.ss")
|
||||
"smtp-sig.ss"
|
||||
"smtp-unit.ss")
|
||||
(require (lib "unit.ss") "smtp-sig.ss" "smtp-unit.ss")
|
||||
|
||||
(define-values/invoke-unit/infer smtp@)
|
||||
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
(module tcp-unit mzscheme
|
||||
(provide tcp@)
|
||||
|
||||
(require (lib "unit.ss")
|
||||
"tcp-sig.ss")
|
||||
(require (lib "unit.ss") "tcp-sig.ss")
|
||||
|
||||
(define-unit-from-context tcp@ tcp^))
|
||||
|
|
|
@ -91,7 +91,8 @@
|
|||
[(regexp-match? re:utf-8 encoding)
|
||||
(bytes->string/utf-8 s #\?)]
|
||||
[else (let ([c (bytes-open-converter
|
||||
(bytes->string/latin-1 encoding) "UTF-8")])
|
||||
(bytes->string/latin-1 encoding)
|
||||
"UTF-8")])
|
||||
(if c
|
||||
(let-values ([(r got status)
|
||||
(bytes-convert c s)])
|
||||
|
|
Loading…
Reference in New Issue
Block a user