1 files changed, 54 insertions, 0 deletions
diff --git a/benchmarks/unparsers.scm b/benchmarks/unparsers.scm
new file mode 100644
index 0000000..b8db0c8
--- /dev/null
+++ b/benchmarks/unparsers.scm
@@ -0,0 +1,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))))))