;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Id: $Id: tests.lisp,v 1.2 2003/08/10 05:16:52 kevin Exp $
+;;;; Id: $Id$
;;;; Purpose: Self Test suite for WOL
;;;;
;;;; *************************************************************************
;; 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))))
+ :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"))
(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"))
+
+(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))))
+ :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"))
(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"))
+(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
(defclass test-server (test-case)
(defmethod tear-down ((self test-server))
- (net.aserve:shutdown :server (wserver self))
- (stop-wol-project (name self)))
+ (net.aserve:shutdown :server (wserver self)))
+
(def-test-method test-server-index ((self test-server) :run nil)
(multiple-value-bind (body response-code headers uri)
(defmethod tear-down ((self test-two-projects))
- (net.aserve:shutdown :server (wserver self))
- (stop-wol-project (name1 self))
- (stop-wol-project (name2 self)))
+ (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)
(defmethod tear-down ((self test-sessions))
- (net.aserve:shutdown :server (wserver self))
- (stop-wol-project (name self)))
+ (net.aserve:shutdown :server (wserver self)))
(defun test-sessions-index (req ent)
(let ((session (websession-from-req req)))
))))
(defmethod tear-down ((self test-no-sessions))
- (net.aserve:shutdown :server (wserver self))
- (stop-wol-project (name self)))
+ (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)
(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))