X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;h=a946f79811e5b8422af70db286e1f4e09f618c81;hb=ba01a7216c7a4c15c103525654fe10ea5845afb1;hp=6fceef89e377decc1cae2ffa4e7ef80e279819be;hpb=0c0d2b88b9c35f1da0f62566768ccc0b6a4c7aa2;p=wol.git

diff --git a/tests.lisp b/tests.lisp
index 6fceef8..a946f79 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; 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
 ;;;;
 ;;;; *************************************************************************
@@ -25,53 +25,118 @@
 ;; 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)
@@ -88,8 +153,8 @@
   
 
 (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)
@@ -171,9 +236,7 @@
   
 
 (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)
@@ -221,8 +284,7 @@
   
 
 (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)))
@@ -278,8 +340,7 @@
 	))))
 
 (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)
@@ -303,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))