mjadud bug

svn: r14426

collects/tests/web-server/dispatchers/dispatch-files-test.ss

@@ -11,6 +11,8 @@
          web-server/dispatchers/dispatch
          (prefix-in files: web-server/dispatchers/dispatch-files)
          "../util.ss")
+(require/expose web-server/dispatchers/dispatch-files
+                (looks-like-directory?))
 (provide dispatch-files-tests)
 
 (define tmp-file (make-temporary-file))
@@ -42,6 +44,14 @@
   (test-suite
    "Files"
    
+   (local [(define (yes s) (test-not-false s (looks-like-directory? s)))
+           (define (no s) (test-false s (looks-like-directory? s)))]
+   (test-suite
+    "Looks like directory"
+
+    (no "") (no "foo") (no "/foo") (no "/foo/bar")
+    (yes "/") (yes "/foo/") (yes "foo/" )(yes "/bar/zog/trog/")))
+   
    (test-case
     "read-range-header: missing and badly formed headers"
     (check-false (files:read-range-header (list (make-header #"Ranges" #"bytes=1-10"))) "check 1")
@@ -109,3 +119,6 @@
    (test-exn "dir, not exists, head"
              exn:dispatcher?
              (lambda () (collect (dispatch #f a-dir) (req #t #"HEAD" empty))))))
+
+#;(require (planet schematics/schemeunit:3/text-ui))
+#;(run-tests dispatch-files-tests)

collects/web-server/dispatchers/dispatch-files.ss

@@ -22,7 +22,8 @@
 ;; looks-like-directory : str -> bool
 ;; to determine if is url style path looks like it refers to a directory
 (define (looks-like-directory? path)
-  (eq? #\/ (string-ref path (sub1 (string-length path)))))
+  (and (regexp-match #rx"/$" path)
+       #t))
 
 (define interface-version 'v1)