X-Git-Url: http://git.kpe.io/?p=wol.git;a=blobdiff_plain;f=tests.lisp;h=d1b2d210887500d44d0682e0d514730ffc2b7cc3;hp=c2f91ea2bd9954352dc3b172be3a5f21d5d4bdeb;hb=5b681c40455d3619afb96a8335a94cd2a411e0c6;hpb=ca586910648f4844e335d92f23e619fd2b84f969

diff --git a/tests.lisp b/tests.lisp
index c2f91ea..d1b2d21 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: tests.lisp,v 1.4 2003/08/15 14:04:57 kevin Exp $
 ;;;; 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)
@@ -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))