Commit failing test: route capture should not match empty string

test/suite/Snap/Internal/Routing/Tests.hs

@@ -6,6 +6,7 @@ module Snap.Internal.Routing.Tests
   ( tests ) where
 
 ------------------------------------------------------------------------------
+import           Control.Applicative ((<|>))
 import           Control.Monad
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as S
@@ -55,6 +56,7 @@ tests = [ testRouting1
         , testRouteLocal
         , testRouteUrlDecode
         , testRouteUrlEncodedPath
+        , testRouteEmptyCapture
         ]
 
 
@@ -128,6 +130,11 @@ routes7 = route [ ("foo/:id"       , fooCapture )
                 , (""              , topTop     ) ]
 
 
+------------------------------------------------------------------------------
+routesEmptyCapture :: Snap ByteString
+routesEmptyCapture = route [ ("foo/:id", fooCapture) ]
+
+
 ------------------------------------------------------------------------------
 topTop, topFoo, fooBar, fooCapture, getRqPathInfo, bar,
   getRqContextPath, barQuux, dblA, zabc, topCapture,
@@ -393,3 +400,17 @@ testRouteLocal = testCase "route/routeLocal" $ do
     r4 <- go routesLocal "foo/bar/baz/quux"
     assertEqual "/foo/bar/baz/quux" "foo/bar/baz/quux" r4
     expectExceptionH $ go routesLocal "bar"
+
+
+------------------------------------------------------------------------------
+testRouteEmptyCapture :: Test
+testRouteEmptyCapture = testCase "route/emptyCapture" $ do
+    r <- go m "foo"
+    assertEqual "empty capture must fail" expected r
+
+    r2 <- go m "foo/"
+    assertEqual "empty capture must fail" expected r2
+
+  where
+    expected = "ZOMG_OK"
+    m        = routesEmptyCapture <|> return expected