Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Basic test infrastructure

Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
  • Loading branch information...
commit 4f7c682dedda90e6cf5b6462165e2c011e4a6ef8 1 parent 6dd1afd
@mario-goulart mario-goulart authored committed
Showing with 106 additions and 1 deletion.
  1. +3 −1 pastiche.meta
  2. +77 −0 tests/client.scm
  3. +26 −0 tests/run.scm
View
4 pastiche.meta
@@ -1,6 +1,8 @@
+;; -*- scheme -*-
((author "Christian Kellermann")
(synopsis "A small awful app implementing a pastebin service")
(license "bsd")
(category web)
- (depends (awful "0.31") (awful-sql-de-lite "0.4") (simple-sha1 "0.1") html-parser colorize miscmacros))
+ (depends (awful "0.31") (awful-sql-de-lite "0.4") (simple-sha1 "0.1") html-parser colorize miscmacros)
+ (test-depends http-client test server-test sxpath))
View
77 tests/client.scm
@@ -0,0 +1,77 @@
+(use test http-client posix setup-api intarweb uri-common awful html-parser sxpath)
+
+(define server-uri "http://localhost:8080")
+
+
+(define (get path/vars)
+ (let ((val (with-input-from-request
+ (make-pathname server-uri path/vars)
+ #f
+ read-string)))
+ (close-all-connections!)
+ val))
+
+
+(define (post path #!optional data)
+ (let ((val (with-input-from-request
+ (make-request
+ uri: (uri-reference (make-pathname server-uri path))
+ method: 'POST)
+ data
+ read-string)))
+ (close-all-connections!)
+ val))
+
+
+(define (get-paste-link sxml)
+ (let ((links ((sxpath '(// a)) sxml)))
+ (let loop ((links links))
+ (if (null? links)
+ #f
+ (let* ((link (car links))
+ (maybe-link (last link)))
+ (if (and (string? maybe-link)
+ (string-prefix? "/paste?id=" maybe-link))
+ maybe-link
+ (loop (cdr links))))))))
+
+
+(define (get-paste-from-html html)
+ (let ((sxml (html->sxml html)))
+ (last (car ((sxpath '(// tt)) sxml)))))
+
+
+(define (paste-link->id link)
+ (substring link 10))
+
+
+(define response
+ (html->sxml
+ (post "/paste" '((nick . "a nick")
+ (title . "a title")
+ (paste . "a paste")))))
+
+
+(define paste-link #f)
+
+(test-begin "pastiche")
+
+(test-assert "Basic response sanity check"
+ (pair? response))
+
+(test-assert "Finding test paste link"
+ (let ((link (get-paste-link response)))
+ (set! paste-link link)
+ (and (string? link)
+ (string-prefix? "/paste?id=" link))))
+
+(test "Checking raw paste"
+ "a paste"
+ (get (string-append "/raw?id=" (paste-link->id paste-link) ";annotation=0")))
+
+
+(test "Checking HTML paste (view paste)"
+ "a paste"
+ (get-paste-from-html (get paste-link)))
+
+(test-end "pastiche")
View
26 tests/run.scm
@@ -0,0 +1,26 @@
+(use awful pastiche server-test)
+
+(define pastiche-db "pastiche.db")
+
+(define (run-pastiche! #!optional use-captcha?)
+ (delete-file* pastiche-db)
+ (pastiche "/" pastiche-db
+ use-captcha?: use-captcha?
+ awful-settings:
+ (lambda (handler)
+ (parameterize
+ ((page-css "http://wiki.call-cc.org/chicken.css")
+ (page-charset "UTF-8")
+ (page-doctype "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))
+ (handler)))))
+
+;;;
+;;; Without captcha
+;;;
+(with-test-server
+ (lambda ()
+ (awful-start run-pastiche!))
+ (lambda ()
+ (load "client.scm")))
+
+(test-exit)
Please sign in to comment.
Something went wrong with that request. Please try again.