summaryrefslogtreecommitdiff
path: root/benchmarks/unparsers.scm
blob: b8db0c83b99afd3e3332d89349fb76d4f11700cb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
(import chicken.port chicken.time chicken.time.posix intarweb uri-common)

(define null-output-port
  (make-output-port void void))

(begin (newline)
       (print "---  Response unparsing ---")
       (begin (print "Unparsing a minimal HTTP/1.1 response many times")
              (let ((response (make-response port: null-output-port)))
                (time (do ((i 0 (add1 i)))
                          ((= i 100000))
                        (write-response response)))))

       (begin (print "Unparsing a realistic HTTP/1.1 response many times")
              (let ((response
                     (make-response
                      port: null-output-port
                      headers: (headers
                                `((content-type text/css)
                                  (etag (strong . "1234-0123456789"))
                                  (content-length 1234)
                                  (last-modified #(,(seconds->utc-time (current-seconds)) ()))
                                  (date #(,(seconds->utc-time (current-seconds)) ())))))))
                (time (do ((i 0 (add1 i)))
                          ((= i 100000))
                        (write-response response))))))

(begin (newline)
       (print "---  Request unparsing ---")
       (begin (print "Unparsing a minimal HTTP/1.1 request many times")
              (let ((request
                     (make-request port: null-output-port)))
                (time (do ((i 0 (add1 i)))
                          ((= i 100000))
                        (write-request request)))))

       (begin (print "Unparsing a realistic HTTP/1.1 request many times")
              (let ((request
                     (make-request
                      port: null-output-port
                      uri: (uri-reference "http://www.call-cc.org/test.example")
                      headers: (headers
                                `((user-agent (("Mozilla" "5.0"
                                                "X11; U; NetBSD amd64; en-US; rv:1.9.0.3")
                                               ("Gecko" "2008110501" #f)
                                               ("Minefield" "3.0.3" #f)))
                                  (host ("example.com" . 8080))
                                  (accept text/html application/xhtml+xml
                                          #(application/xml ((q . 0.9))) #(*/* ((q . 0.8))))
                                  (accept-language en-US #(en ((q . 0.5))))
                                  (accept-encoding gzip deflate))))))
                (time (do ((i 0 (add1 i)))
                          ((= i 100000))
                        (write-request request))))))