X-Git-Url: http://git.kpe.io/?p=wol.git;a=blobdiff_plain;f=tests.lisp;h=bbcb3b6411414a4d96bd9adac2e62850d1d063f6;hp=c2f91ea2bd9954352dc3b172be3a5f21d5d4bdeb;hb=HEAD;hpb=ca586910648f4844e335d92f23e619fd2b84f969 diff --git a/tests.lisp b/tests.lisp index c2f91ea..bbcb3b6 100644 --- a/tests.lisp +++ b/tests.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Id: $Id: tests.lisp,v 1.3 2003/08/10 17:56:44 kevin Exp $ +;;;; Id: $Id$ ;;;; Purpose: Self Test suite for WOL ;;;; ;;;; ************************************************************************* @@ -12,65 +12,130 @@ (defpackage #:wol-tests (:use #:xlunit #:cl #:wol #:puri #:lml2 #:kmrcl) (:export #:do-tests #:*all-tests*)) - + (in-package #:wol-tests) (eval-when (:compile-toplevel :load-toplevel :execute) (import '(wol::req-recode-uri-sans-session-id wol::request-uri - wol::request-decoded-uri-path wol::websession-from-req - wol::websession-key wol::+length-session-id+ - wol::set-cookies-in-headers))) + wol::request-decoded-uri-path wol::websession-from-req + wol::websession-key wol::+length-session-id+ + wol::set-cookies-in-headers))) ;; Keyed URL Tests (defclass test-keyed-url (test-case) - ((req :accessor req))) + ((req :accessor req) + (ent :accessor ent))) (defmethod set-up ((self test-keyed-url)) (let ((uri (parse-uri "/~abcdefg~/index.html"))) (setf (req self) (make-instance 'wol::http-request - :raw-uri uri - :decoded-uri-path (render-uri uri nil) - :uri uri)))) + :raw-uri uri + :decoded-uri-path (render-uri uri nil) + :uri uri)) + (setf (ent self) (make-instance 'wol::entity + :project (make-instance 'wol::wol-project + :project-prefix "/"))))) (def-test-method test-returned-session ((self test-keyed-url) :run nil) - (assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self)))) - + (assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self) + (ent self)))) + (def-test-method test-recomputed-uri ((self test-keyed-url) :run nil) - (req-recode-uri-sans-session-id (req self)) + (req-recode-uri-sans-session-id (req self) (ent self)) (assert-equal (render-uri (request-uri (req self)) nil) - "/index.html")) + "/index.html")) (def-test-method test-decoded-uri ((self test-keyed-url) :run nil) - (req-recode-uri-sans-session-id (req self)) + (req-recode-uri-sans-session-id (req self) (ent self)) (assert-equal (request-decoded-uri-path (req self)) - "/index.html")) + "/index.html")) + + +(defclass test-keyed-url-2 (test-case) + ((req :accessor req) + (ent :accessor ent))) + +(defmethod set-up ((self test-keyed-url-2)) + (let ((uri (parse-uri "/app/~abcdefg~/index.html"))) + (setf (req self) (make-instance 'wol::http-request + :raw-uri uri + :decoded-uri-path (render-uri uri nil) + :uri uri)) + (setf (ent self) (make-instance 'wol::entity + :project (make-instance 'wol::wol-project + :project-prefix "/app/"))))) + +(def-test-method test-returned-session ((self test-keyed-url-2) :run nil) + (assert-equal "abcdefg" (req-recode-uri-sans-session-id (req self) + (ent self)))) + +(def-test-method test-recomputed-uri ((self test-keyed-url-2) :run nil) + (req-recode-uri-sans-session-id (req self) (ent self)) + (assert-equal (render-uri (request-uri (req self)) nil) + "/app/index.html")) + +(def-test-method test-decoded-uri ((self test-keyed-url-2) :run nil) + (req-recode-uri-sans-session-id (req self) (ent self)) + (assert-equal (request-decoded-uri-path (req self)) + "/app/index.html")) ;;; Non-keyed URL tests (defclass test-non-keyed-url (test-case) - ((req :accessor req))) + ((req :accessor req) + (ent :accessor ent))) (defmethod set-up ((self test-non-keyed-url)) (let ((uri (parse-uri "/index.html"))) (setf (req self) (make-instance 'wol::http-request - :raw-uri uri - :decoded-uri-path (render-uri uri nil) - :uri uri)))) + :raw-uri uri + :decoded-uri-path (render-uri uri nil) + :uri uri)) + (setf (ent self) (make-instance 'wol::entity + :project (make-instance 'wol::wol-project + :project-prefix "/"))))) (def-test-method test-returned-session ((self test-non-keyed-url) :run nil) - (assert-false (req-recode-uri-sans-session-id (req self)))) - + (assert-false (req-recode-uri-sans-session-id (req self) (ent self)))) + (def-test-method test-recomputed-uri ((self test-non-keyed-url) :run nil) - (req-recode-uri-sans-session-id (req self)) + (req-recode-uri-sans-session-id (req self) (ent self)) (assert-equal (render-uri (request-uri (req self)) nil) - "/index.html")) + "/index.html")) (def-test-method test-decoded-uri ((self test-non-keyed-url) :run nil) - (req-recode-uri-sans-session-id (req self)) + (req-recode-uri-sans-session-id (req self) (ent self)) (assert-equal (request-decoded-uri-path (req self)) - "/index.html")) + "/index.html")) + +(defclass test-non-keyed-url-2 (test-case) + ((req :accessor req) + (ent :accessor ent))) + +(defmethod set-up ((self test-non-keyed-url-2)) + (let ((uri (parse-uri "/app1/index.html"))) + (setf (req self) (make-instance 'wol::http-request + :raw-uri uri + :decoded-uri-path (render-uri uri nil) + :uri uri)) + (setf (ent self) (make-instance 'wol::entity + :project (make-instance 'wol::wol-project + :project-prefix "/app1/"))))) + +(def-test-method test-returned-session ((self test-non-keyed-url-2) :run nil) + (assert-false (req-recode-uri-sans-session-id (req self) (ent self)))) + +(def-test-method test-recomputed-uri ((self test-non-keyed-url-2) :run nil) + (req-recode-uri-sans-session-id (req self) (ent self)) + (assert-equal (render-uri (request-uri (req self)) nil) + "/app1/index.html")) + +(def-test-method test-decoded-uri ((self test-non-keyed-url-2) :run nil) + (req-recode-uri-sans-session-id (req self) (ent self)) + (assert-equal (request-decoded-uri-path (req self)) + "/app1/index.html")) ;;; Test server @@ -81,11 +146,11 @@ )) (defmethod set-up ((self test-server)) - (setf (wserver self) (net.aserve:start :port (port self) :server :new)) + (setf (wserver self) (net.aserve:start :port (port self) :server :new)) (setq net.aserve::*enable-logging* nil) (wol-project (name self) :index "index" :connector :aserve - :server (wserver self))) - + :server (wserver self))) + (defmethod tear-down ((self test-server)) (net.aserve:shutdown :server (wserver self))) @@ -93,57 +158,57 @@ (def-test-method test-server-index ((self test-server) :run nil) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/") - :port (port self)) nil) - :redirect nil) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/") + :port (port self)) nil) + :redirect nil) (declare (ignore uri)) (assert-true (zerop (length body))) (let ((redir (parse-uri - (cdr (assoc "Location" headers :test #'string-equal))))) + (cdr (assoc "Location" headers :test #'string-equal))))) (assert-equal (uri-path redir) "/index.html")) (assert-equal response-code 307) )) (def-test-method test-prefix-index-1 ((self test-server) :run nil) (wol-project (name self) :index "index" :connector :aserve - :project-prefix "/aprefix/" :server (wserver self)) + :project-prefix "/aprefix/" :server (wserver self)) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/aprefix/") - :port (port self)) nil) - :redirect nil) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/aprefix/") + :port (port self)) nil) + :redirect nil) (declare (ignore uri)) (assert-equal "" body) (let ((redir (parse-uri - (cdr (assoc "Location" headers :test #'string-equal))))) + (cdr (assoc "Location" headers :test #'string-equal))))) (assert-equal (uri-path redir) "/aprefix/index.html")) (assert-equal response-code 307))) (def-test-method test-prefix-index-2 ((self test-server) :run nil) (wol-project (name self) :index "index" :connector :aserve - :project-prefix "/aprefix/" :server (wserver self)) + :project-prefix "/aprefix/" :server (wserver self)) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/ab") - :port (port self)) nil) - :redirect nil) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/ab") + :port (port self)) nil) + :redirect nil) (declare (ignore uri headers)) (assert-equal response-code 404) (assert-true (plusp (length body)))) - + (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/") - :port (port self)) nil) - :redirect nil) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/") + :port (port self)) nil) + :redirect nil) (declare (ignore uri headers)) (assert-true (plusp (length body))) (assert-equal response-code 404)) - + ) @@ -159,41 +224,41 @@ )) (defmethod set-up ((self test-two-projects)) - (setf (wserver self) (net.aserve:start :port (port self) :server :new)) + (setf (wserver self) (net.aserve:start :port (port self) :server :new)) (setq net.aserve::*enable-logging* nil) (wol-project (name1 self) :index "index1" :connector :aserve - :project-prefix (prefix1 self) - :server (wserver self)) + :project-prefix (prefix1 self) + :server (wserver self)) (wol-project (name2 self) :index "index2" :connector :aserve - :project-prefix (prefix2 self) - :server (wserver self)) - ) - + :project-prefix (prefix2 self) + :server (wserver self)) + ) + (defmethod tear-down ((self test-two-projects)) (net.aserve:shutdown :server (wserver self))) (def-test-method test-two-project-index ((self test-two-projects) :run nil) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/testprefix/") - :port (port self)) nil) - :redirect nil) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/testprefix/") + :port (port self)) nil) + :redirect nil) (declare (ignore uri)) (assert-true (zerop (length body))) (let ((redir (parse-uri - (cdr (assoc "Location" headers :test #'string-equal))))) + (cdr (assoc "Location" headers :test #'string-equal))))) (assert-equal (uri-path redir) "/testprefix/index1.html")) (assert-equal response-code 307)) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/") - :port (port self)) nil) - :redirect nil) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/prefixtest/") + :port (port self)) nil) + :redirect nil) (declare (ignore uri)) (assert-true (zerop (length body))) (let ((redir (parse-uri - (cdr (assoc "Location" headers :test #'string-equal))))) + (cdr (assoc "Location" headers :test #'string-equal))))) (assert-equal (uri-path redir) "/prefixtest/index2.html")) (assert-equal response-code 307) )) @@ -209,14 +274,14 @@ )) (defmethod set-up ((self test-sessions)) - (setf (wserver self) (net.aserve:start :port (port self) :server :new)) + (setf (wserver self) (net.aserve:start :port (port self) :server :new)) (setq net.aserve::*enable-logging* nil) (wol-project (name self) :index "index" :connector :aserve - :sessions t - :map '(("index" test-sessions-index)) - :project-prefix (prefix self) - :server (wserver self))) - + :sessions t + :map '(("index" test-sessions-index)) + :project-prefix (prefix self) + :server (wserver self))) + (defmethod tear-down ((self test-sessions)) (net.aserve:shutdown :server (wserver self))) @@ -225,16 +290,16 @@ (let ((session (websession-from-req req))) (with-wol-page (req ent) (let ((url (make-wol-url "page" req ent))) - (format *html-stream* "index~%") - (format *html-stream* "~A~%" (websession-key session)) - (format *html-stream* "~A~%" url) - )))) + (format *html-stream* "index~%") + (format *html-stream* "~A~%" (websession-key session)) + (format *html-stream* "~A~%" url) + )))) (def-test-method test-sessions ((self test-sessions) :run nil) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/index.html") - :port (port self)) nil)) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/index.html") + :port (port self)) nil)) (declare (ignore uri)) (assert-equal response-code 200) (let ((cookies (set-cookies-in-headers headers))) @@ -244,7 +309,7 @@ (assert-equal (first lines) "index") (assert-equal (length (second lines)) +length-session-id+) (assert-equal (third lines) - (format nil "/~~~A~~/page.html" (second lines)))))) + (format nil "/~~~A~~/page.html" (second lines)))))) ;;; Test no sessions @@ -257,31 +322,31 @@ )) (defmethod set-up ((self test-no-sessions)) - (setf (wserver self) (net.aserve:start :port (port self) :server :new)) + (setf (wserver self) (net.aserve:start :port (port self) :server :new)) (setq net.aserve::*enable-logging* nil) (wol-project (name self) :index "index" :connector :aserve - :sessions nil - :map '(("index" test-no-sessions-index)) - :project-prefix (prefix self) - :server (wserver self))) + :sessions nil + :map '(("index" test-no-sessions-index)) + :project-prefix (prefix self) + :server (wserver self))) (defun test-no-sessions-index (req ent) (let ((session (websession-from-req req))) (with-wol-page (req ent) (let ((url (make-wol-url "page" req ent))) - (format *html-stream* "index~%") - (format *html-stream* "~(~A~)~%" session) - (format *html-stream* "~A~%" url) - )))) + (format *html-stream* "index~%") + (format *html-stream* "~(~A~)~%" session) + (format *html-stream* "~A~%" url) + )))) (defmethod tear-down ((self test-no-sessions)) (net.aserve:shutdown :server (wserver self))) (def-test-method test-no-sessions ((self test-no-sessions) :run nil) (multiple-value-bind (body response-code headers uri) - (net.aserve.client:do-http-request - (render-uri (copy-uri (parse-uri "http://localhost/index.html") - :port (port self)) nil)) + (net.aserve.client:do-http-request + (render-uri (copy-uri (parse-uri "http://localhost/index.html") + :port (port self)) nil)) (declare (ignore uri)) (assert-equal response-code 200) (let ((cookies (set-cookies-in-headers headers))) @@ -299,7 +364,9 @@ (defparameter *all-tests* (make-instance 'all-tests)) (add-test *all-tests* (get-suite test-keyed-url)) +(add-test *all-tests* (get-suite test-keyed-url-2)) (add-test *all-tests* (get-suite test-non-keyed-url)) +(add-test *all-tests* (get-suite test-non-keyed-url-2)) (add-test *all-tests* (get-suite test-server)) (add-test *all-tests* (get-suite test-two-projects)) (add-test *all-tests* (get-suite test-sessions))