;;;; *************************************************************************
;;;; 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
;;;;
;;;; *************************************************************************
;; 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)
(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))