diff --git a/test/suite/Snap/Internal/Routing/Tests.hs b/test/suite/Snap/Internal/Routing/Tests.hs index b6acbfcc..e438ce2a 100644 --- a/test/suite/Snap/Internal/Routing/Tests.hs +++ b/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