Fixed up tests
This commit is contained in:
parent
1718c5bf1e
commit
920d9cbea8
@ -46,7 +46,7 @@ module Yesod.Content
|
||||
, formatW3
|
||||
, formatRFC1123
|
||||
#if TEST
|
||||
, testSuite
|
||||
, contentTestSuite
|
||||
#endif
|
||||
) where
|
||||
|
||||
@ -245,8 +245,8 @@ ext = reverse . fst . break (== '.') . reverse
|
||||
|
||||
#if TEST
|
||||
---- Testing
|
||||
testSuite :: Test
|
||||
testSuite = testGroup "Yesod.Resource"
|
||||
contentTestSuite :: Test
|
||||
contentTestSuite = testGroup "Yesod.Resource"
|
||||
[ testProperty "ext" propExt
|
||||
, testCase "typeByExt" caseTypeByExt
|
||||
]
|
||||
|
||||
@ -25,18 +25,12 @@ module Yesod.Core
|
||||
-- * Misc
|
||||
, yesodVersion
|
||||
#if TEST
|
||||
, testSuite
|
||||
, coreTestSuite
|
||||
#endif
|
||||
) where
|
||||
|
||||
#if TEST
|
||||
import Yesod.Content hiding (testSuite)
|
||||
import Yesod.Handler hiding (testSuite)
|
||||
import qualified Data.ByteString.UTF8 as BSU
|
||||
#else
|
||||
import Yesod.Content
|
||||
import Yesod.Handler
|
||||
#endif
|
||||
|
||||
import qualified Paths_yesod_core
|
||||
import Data.Version (showVersion)
|
||||
@ -63,6 +57,8 @@ import Test.Framework (testGroup, Test)
|
||||
import Test.Framework.Providers.HUnit
|
||||
import Test.Framework.Providers.QuickCheck2 (testProperty)
|
||||
import Test.HUnit hiding (Test)
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.Encoding
|
||||
#endif
|
||||
|
||||
#if GHC7
|
||||
@ -447,8 +443,8 @@ $maybe jscript j
|
||||
return $ PageContent title head'' body
|
||||
|
||||
#if TEST
|
||||
testSuite :: Test
|
||||
testSuite = testGroup "Yesod.Yesod"
|
||||
coreTestSuite :: Test
|
||||
coreTestSuite = testGroup "Yesod.Yesod"
|
||||
[ testProperty "join/split path" propJoinSplitPath
|
||||
, testCase "join/split path [\".\"]" caseJoinSplitPathDquote
|
||||
, testCase "utf8 split path" caseUtf8SplitPath
|
||||
@ -460,34 +456,37 @@ data TmpRoute = TmpRoute deriving Eq
|
||||
type instance Route TmpYesod = TmpRoute
|
||||
instance Yesod TmpYesod where approot _ = ""
|
||||
|
||||
fromString :: String -> S8.ByteString
|
||||
fromString = Data.Text.Encoding.encodeUtf8 . Data.Text.pack
|
||||
|
||||
propJoinSplitPath :: [String] -> Bool
|
||||
propJoinSplitPath ss =
|
||||
splitPath TmpYesod (BSU.fromString $ joinPath TmpYesod "" ss' [])
|
||||
splitPath TmpYesod (fromString $ joinPath TmpYesod "" ss' [])
|
||||
== Right ss'
|
||||
where
|
||||
ss' = filter (not . null) ss
|
||||
|
||||
caseJoinSplitPathDquote :: Assertion
|
||||
caseJoinSplitPathDquote = do
|
||||
splitPath TmpYesod (BSU.fromString "/x%2E/") @?= Right ["x."]
|
||||
splitPath TmpYesod (BSU.fromString "/y./") @?= Right ["y."]
|
||||
splitPath TmpYesod (fromString "/x%2E/") @?= Right ["x."]
|
||||
splitPath TmpYesod (fromString "/y./") @?= Right ["y."]
|
||||
joinPath TmpYesod "" ["z."] [] @?= "/z./"
|
||||
x @?= Right ss
|
||||
where
|
||||
x = splitPath TmpYesod (BSU.fromString $ joinPath TmpYesod "" ss' [])
|
||||
x = splitPath TmpYesod (fromString $ joinPath TmpYesod "" ss' [])
|
||||
ss' = filter (not . null) ss
|
||||
ss = ["a."]
|
||||
|
||||
caseUtf8SplitPath :: Assertion
|
||||
caseUtf8SplitPath = do
|
||||
Right ["שלום"] @=?
|
||||
splitPath TmpYesod (BSU.fromString "/שלום/")
|
||||
splitPath TmpYesod (fromString "/שלום/")
|
||||
Right ["page", "Fooé"] @=?
|
||||
splitPath TmpYesod (BSU.fromString "/page/Fooé/")
|
||||
splitPath TmpYesod (fromString "/page/Fooé/")
|
||||
Right ["\156"] @=?
|
||||
splitPath TmpYesod (BSU.fromString "/\156/")
|
||||
splitPath TmpYesod (fromString "/\156/")
|
||||
Right ["ð"] @=?
|
||||
splitPath TmpYesod (BSU.fromString "/%C3%B0/")
|
||||
splitPath TmpYesod (fromString "/%C3%B0/")
|
||||
|
||||
caseUtf8JoinPath :: Assertion
|
||||
caseUtf8JoinPath = do
|
||||
|
||||
@ -12,27 +12,20 @@ module Yesod.Dispatch
|
||||
, mkYesodData
|
||||
, mkYesodSubData
|
||||
, mkYesodDispatch
|
||||
, mkYesodSubDispatch
|
||||
, mkYesodSubDispatch
|
||||
-- ** Path pieces
|
||||
, SinglePiece (..)
|
||||
, MultiPiece (..)
|
||||
, Strings
|
||||
-- * Convert to WAI
|
||||
, toWaiApp
|
||||
, basicHandler
|
||||
, basicHandler'
|
||||
#if TEST
|
||||
, testSuite
|
||||
, dispatchTestSuite
|
||||
#endif
|
||||
) where
|
||||
|
||||
#if TEST
|
||||
import Yesod.Core hiding (testSuite)
|
||||
import Yesod.Handler hiding (testSuite)
|
||||
#else
|
||||
import Yesod.Core
|
||||
import Yesod.Handler
|
||||
#endif
|
||||
|
||||
import Yesod.Request
|
||||
import Yesod.Internal
|
||||
@ -47,10 +40,6 @@ import Network.Wai.Middleware.CleanPath (cleanPath)
|
||||
import Network.Wai.Middleware.Jsonp
|
||||
import Network.Wai.Middleware.Gzip
|
||||
|
||||
import qualified Network.Wai.Handler.SimpleServer as SS
|
||||
import qualified Network.Wai.Handler.CGI as CGI
|
||||
import System.Environment (getEnvironment)
|
||||
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
@ -87,13 +76,10 @@ import Test.Framework (testGroup, Test)
|
||||
import Test.Framework.Providers.QuickCheck2 (testProperty)
|
||||
import Test.QuickCheck
|
||||
import System.IO.Unsafe
|
||||
import Yesod.Content hiding (testSuite)
|
||||
import Data.Serialize.Get
|
||||
import Data.Serialize.Put
|
||||
#else
|
||||
import Yesod.Content
|
||||
#endif
|
||||
|
||||
import Yesod.Content
|
||||
|
||||
-- | Generates URL datatype and site function for the given 'Resource's. This
|
||||
-- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
|
||||
-- Use 'parseRoutes' to create the 'Resource's.
|
||||
@ -359,34 +345,6 @@ httpAccept = map B.unpack
|
||||
. lookup "Accept"
|
||||
. W.requestHeaders
|
||||
|
||||
-- | Runs an application with CGI if CGI variables are present (namely
|
||||
-- PATH_INFO); otherwise uses SimpleServer.
|
||||
basicHandler :: (Yesod y, YesodSite y)
|
||||
=> Int -- ^ port number
|
||||
-> y
|
||||
-> IO ()
|
||||
basicHandler port y = basicHandler' port (Just "localhost") y
|
||||
|
||||
|
||||
-- | Same as 'basicHandler', but allows you to specify the hostname to display
|
||||
-- to the user. If 'Nothing' is provided, then no output is produced.
|
||||
basicHandler' :: (Yesod y, YesodSite y)
|
||||
=> Int -- ^ port number
|
||||
-> Maybe String -- ^ host name, 'Nothing' to show nothing
|
||||
-> y
|
||||
-> IO ()
|
||||
basicHandler' port mhost y = do
|
||||
app <- toWaiApp y
|
||||
vars <- getEnvironment
|
||||
case lookup "PATH_INFO" vars of
|
||||
Nothing -> do
|
||||
case mhost of
|
||||
Nothing -> return ()
|
||||
Just h -> putStrLn $ concat
|
||||
["http://", h, ":", show port, "/"]
|
||||
SS.run port app
|
||||
Just _ -> CGI.run app
|
||||
|
||||
parseWaiRequest :: W.Request
|
||||
-> [(String, String)] -- ^ session
|
||||
-> IO Request
|
||||
@ -518,8 +476,8 @@ getTime = do
|
||||
|
||||
#if TEST
|
||||
|
||||
testSuite :: Test
|
||||
testSuite = testGroup "Yesod.Dispatch"
|
||||
dispatchTestSuite :: Test
|
||||
dispatchTestSuite = testGroup "Yesod.Dispatch"
|
||||
[ testProperty "encode/decode session" propEncDecSession
|
||||
, testProperty "get/put time" propGetPutTime
|
||||
]
|
||||
|
||||
@ -88,7 +88,7 @@ module Yesod.Handler
|
||||
, ErrorResponse (..)
|
||||
, YesodAppResult (..)
|
||||
#if TEST
|
||||
, testSuite
|
||||
, handlerTestSuite
|
||||
#endif
|
||||
) where
|
||||
|
||||
@ -120,14 +120,10 @@ import qualified Data.ByteString.Char8 as S8
|
||||
|
||||
#if TEST
|
||||
import Test.Framework (testGroup, Test)
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.HUnit hiding (Test)
|
||||
import Yesod.Content hiding (testSuite)
|
||||
import Data.IORef
|
||||
#else
|
||||
import Yesod.Content
|
||||
#endif
|
||||
|
||||
import Yesod.Content
|
||||
|
||||
-- | The type-safe URLs associated with a site argument.
|
||||
type family Route a
|
||||
|
||||
@ -580,8 +576,8 @@ getSession = GHandler $ lift $ lift $ lift get
|
||||
|
||||
#if TEST
|
||||
|
||||
testSuite :: Test
|
||||
testSuite = testGroup "Yesod.Handler"
|
||||
handlerTestSuite :: Test
|
||||
handlerTestSuite = testGroup "Yesod.Handler"
|
||||
[
|
||||
]
|
||||
|
||||
|
||||
18
runtests.hs
18
runtests.hs
@ -1,18 +1,12 @@
|
||||
import Test.Framework (defaultMain)
|
||||
|
||||
import qualified Yesod.Content
|
||||
import qualified Yesod.Json
|
||||
import qualified Yesod.Dispatch
|
||||
import qualified Yesod.Helpers.Static
|
||||
import qualified Yesod.Yesod
|
||||
import qualified Yesod.Handler
|
||||
import Yesod.Content
|
||||
import Yesod.Dispatch
|
||||
import Yesod.Handler
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
[ Yesod.Content.testSuite
|
||||
, Yesod.Json.testSuite
|
||||
, Yesod.Dispatch.testSuite
|
||||
, Yesod.Helpers.Static.testSuite
|
||||
, Yesod.Yesod.testSuite
|
||||
, Yesod.Handler.testSuite
|
||||
[ contentTestSuite
|
||||
, dispatchTestSuite
|
||||
, handlerTestSuite
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user