Fixed up tests

This commit is contained in:
Michael Snoyman 2010-12-25 21:00:38 +02:00
parent 1718c5bf1e
commit 920d9cbea8
5 changed files with 36 additions and 89 deletions

View File

@ -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
]

View File

@ -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

View File

@ -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
]

View File

@ -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"
[
]

View File

@ -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
]