summaryrefslogtreecommitdiff
path: root/benchmarks
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2018-06-22 22:22:24 +0200
committerPeter Bex <peter@more-magic.net>2018-06-22 22:22:24 +0200
commit90a1f7d47525cfffe928e9a89becf622bd85a8a1 (patch)
treeef5043b60d49425f702fd154ee3ba1088a68677c /benchmarks
downloadintarweb-90a1f7d47525cfffe928e9a89becf622bd85a8a1.tar.gz
Initial CHICKEN 5 port of intarweb 1.72.0
Diffstat (limited to 'benchmarks')
-rw-r--r--benchmarks/parsers.scm60
-rw-r--r--benchmarks/run.scm7
-rw-r--r--benchmarks/unparsers.scm54
3 files changed, 121 insertions, 0 deletions
diff --git a/benchmarks/parsers.scm b/benchmarks/parsers.scm
new file mode 100644
index 0000000..e4612e2
--- /dev/null
+++ b/benchmarks/parsers.scm
@@ -0,0 +1,60 @@
+(import intarweb chicken.string chicken.time chicken.time.posix
+ chicken.port srfi-13)
+
+(define (mk-headers . strs)
+ (string-append (string-join strs "\r\n") "\r\n\r\n"))
+
+(begin (newline)
+ (print "--- Request parsing ---")
+ (begin (print "Parsing a minimal HTTP/1.0 request many times")
+ (let* ((str (mk-headers "GET / HTTP/1.0"
+ "Host: 127.0.0.1:8080"
+ "User-Agent: ApacheBench/2.3"))
+ (p (open-input-string str)))
+ (time (do ((i 0 (add1 i)))
+ ((= i 100000))
+ (##sys#setslot p 10 0) ; rewind
+ (read-request p)))))
+
+ (begin (print "Parsing a realistic HTTP/1.1 request many times")
+ (let* ((str (mk-headers "GET /foo HTTP/1.1"
+ "Host: localhost:8080"
+ "User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20140722 Firefox/24.0 Iceweasel/24.7.0"
+ "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"
+ "Connection: keep-alive"))
+ (p (open-input-string str)))
+ (time (do ((i 0 (add1 i)))
+ ((= i 100000))
+ (##sys#setslot p 10 0) ; rewind
+ (read-request p))))))
+
+(begin (newline)
+ (print "--- Response parsing ---")
+ (begin (print "Parsing a minimal HTTP/1.0 response many times")
+ (let* ((str (mk-headers "HTTP/1.0 200 OK"
+ "Content-Length: 10"))
+ (p (open-input-string str)))
+ (time (do ((i 0 (add1 i)))
+ ((= i 100000))
+ (##sys#setslot p 10 0) ; rewind
+ (read-response p)))))
+
+ (begin (newline)
+ (print "Parsing a realistic HTTP/1.1 response many times")
+ (let* ((str (mk-headers
+ "HTTP/1.1 404 Not Found"
+ "Date: Tue, 19 Aug 2014 19:14:24 GMT"
+ "Server: Apache"
+ "Vary: Accept-Encoding"
+ "Content-Encoding: gzip"
+ "Content-Length: 176"
+ "Keep-Alive: timeout=15, max=100"
+ "Connection: Keep-Alive"
+ "Content-Type: text/html; charset=iso-8859-1"))
+ (p (open-input-string str)))
+ (time (do ((i 0 (add1 i)))
+ ((= i 100000))
+ (##sys#setslot p 10 0) ; rewind
+ (read-response p))))))
diff --git a/benchmarks/run.scm b/benchmarks/run.scm
new file mode 100644
index 0000000..c7d45c8
--- /dev/null
+++ b/benchmarks/run.scm
@@ -0,0 +1,7 @@
+(print "Unparsers:")
+(print "==========\n")
+(load "unparsers")
+
+(print "\nParsers:")
+(print "==========\n")
+(load "parsers")
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))))))