r5504: *** empty log message ***

[wol.git] / tests.lisp

diff --git a/tests.lisp b/tests.lisp
index c2f91ea2bd9954352dc3b172be3a5f21d5d4bdeb..d1b2d210887500d44d0682e0d514730ffc2b7cc3 100644 (file)
--- 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))