hspec 1.3
This commit is contained in:
parent
60b7111529
commit
df5018a94c
2
scripts
2
scripts
@ -1 +1 @@
|
|||||||
Subproject commit eba05a0b5fe121883969f8fa9b7f7669592430a4
|
Subproject commit bf06d8e764f3d2931c0a676dc5c6fc14491b012a
|
||||||
@ -2,4 +2,4 @@ import Test.Hspec
|
|||||||
import qualified YesodCoreTest
|
import qualified YesodCoreTest
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspecX $ YesodCoreTest.specs
|
main = hspec YesodCoreTest.specs
|
||||||
|
|||||||
@ -15,18 +15,17 @@ import qualified YesodCoreTest.JsLoader as JsLoader
|
|||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
specs :: [Spec]
|
specs :: Spec
|
||||||
specs =
|
specs = do
|
||||||
[ cleanPathTest
|
cleanPathTest
|
||||||
, exceptionsTest
|
exceptionsTest
|
||||||
, widgetTest
|
widgetTest
|
||||||
, mediaTest
|
mediaTest
|
||||||
, linksTest
|
linksTest
|
||||||
, noOverloadedTest
|
noOverloadedTest
|
||||||
, internalRequestTest
|
internalRequestTest
|
||||||
, errorHandlingTest
|
errorHandlingTest
|
||||||
, cacheTest
|
cacheTest
|
||||||
, WaiSubsite.specs
|
WaiSubsite.specs
|
||||||
, Redirect.specs
|
Redirect.specs
|
||||||
, JsLoader.specs
|
JsLoader.specs
|
||||||
]
|
|
||||||
|
|||||||
@ -37,9 +37,8 @@ getRootR = do
|
|||||||
|
|
||||||
cacheTest :: Spec
|
cacheTest :: Spec
|
||||||
cacheTest =
|
cacheTest =
|
||||||
describe "Test.Cache"
|
describe "Test.Cache" $ do
|
||||||
[ it "works" works
|
it "works" works
|
||||||
]
|
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
runner f = toWaiApp C >>= runSession f
|
runner f = toWaiApp C >>= runSession f
|
||||||
|
|||||||
@ -64,15 +64,14 @@ getPlainR = return $ RepPlain "plain"
|
|||||||
|
|
||||||
cleanPathTest :: Spec
|
cleanPathTest :: Spec
|
||||||
cleanPathTest =
|
cleanPathTest =
|
||||||
describe "Test.CleanPath"
|
describe "Test.CleanPath" $ do
|
||||||
[ it "remove trailing slash" removeTrailingSlash
|
it "remove trailing slash" removeTrailingSlash
|
||||||
, it "noTrailingSlash" noTrailingSlash
|
it "noTrailingSlash" noTrailingSlash
|
||||||
, it "add trailing slash" addTrailingSlash
|
it "add trailing slash" addTrailingSlash
|
||||||
, it "has trailing slash" hasTrailingSlash
|
it "has trailing slash" hasTrailingSlash
|
||||||
, it "/foo/something" fooSomething
|
it "/foo/something" fooSomething
|
||||||
, it "subsite dispatch" subsiteDispatch
|
it "subsite dispatch" subsiteDispatch
|
||||||
, it "redirect with query string" redQueryString
|
it "redirect with query string" redQueryString
|
||||||
]
|
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
runner f = toWaiApp Y >>= runSession f
|
runner f = toWaiApp Y >>= runSession f
|
||||||
|
|||||||
@ -67,13 +67,12 @@ getErrorInBodyNoEvalR :: Handler (DontFullyEvaluate RepHtml)
|
|||||||
getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR
|
getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR
|
||||||
|
|
||||||
errorHandlingTest :: Spec
|
errorHandlingTest :: Spec
|
||||||
errorHandlingTest = describe "Test.ErrorHandling"
|
errorHandlingTest = describe "Test.ErrorHandling" $ do
|
||||||
[ it "says not found" caseNotFound
|
it "says not found" caseNotFound
|
||||||
, it "says 'There was an error' before runRequestBody" caseBefore
|
it "says 'There was an error' before runRequestBody" caseBefore
|
||||||
, it "says 'There was an error' after runRequestBody" caseAfter
|
it "says 'There was an error' after runRequestBody" caseAfter
|
||||||
, it "error in body == 500" caseErrorInBody
|
it "error in body == 500" caseErrorInBody
|
||||||
, it "error in body, no eval == 200" caseErrorInBodyNoEval
|
it "error in body, no eval == 200" caseErrorInBodyNoEval
|
||||||
]
|
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
runner f = toWaiApp App >>= runSession f
|
runner f = toWaiApp App >>= runSession f
|
||||||
|
|||||||
@ -31,10 +31,9 @@ getRedirR = do
|
|||||||
redirectWith status301 RootR
|
redirectWith status301 RootR
|
||||||
|
|
||||||
exceptionsTest :: Spec
|
exceptionsTest :: Spec
|
||||||
exceptionsTest = describe "Test.Exceptions"
|
exceptionsTest = describe "Test.Exceptions" $ do
|
||||||
[ it "500" case500
|
it "500" case500
|
||||||
, it "redirect keeps headers" caseRedirect
|
it "redirect keeps headers" caseRedirect
|
||||||
]
|
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
runner f = toWaiApp Y >>= runSession f
|
runner f = toWaiApp Y >>= runSession f
|
||||||
|
|||||||
@ -11,10 +11,9 @@ import Yesod.Request (Request (..))
|
|||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
randomStringSpecs :: Spec
|
randomStringSpecs :: Spec
|
||||||
randomStringSpecs = describe "Yesod.Internal.Request.randomString"
|
randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
|
||||||
[ it "looks reasonably random" looksRandom
|
it "looks reasonably random" looksRandom
|
||||||
, it "does not repeat itself" $ noRepeat 10 100
|
it "does not repeat itself" $ noRepeat 10 100
|
||||||
]
|
|
||||||
|
|
||||||
-- NOTE: this testcase may break on other systems/architectures if
|
-- NOTE: this testcase may break on other systems/architectures if
|
||||||
-- mkStdGen is not identical everywhere (is it?).
|
-- mkStdGen is not identical everywhere (is it?).
|
||||||
@ -31,12 +30,11 @@ g = error "test/YesodCoreTest/InternalRequest.g"
|
|||||||
|
|
||||||
|
|
||||||
tokenSpecs :: Spec
|
tokenSpecs :: Spec
|
||||||
tokenSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqToken)"
|
tokenSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqToken)" $ do
|
||||||
[ it "is Nothing if sessions are disabled" noDisabledToken
|
it "is Nothing if sessions are disabled" noDisabledToken
|
||||||
, it "ignores pre-existing token if sessions are disabled" ignoreDisabledToken
|
it "ignores pre-existing token if sessions are disabled" ignoreDisabledToken
|
||||||
, it "uses preexisting token in session" useOldToken
|
it "uses preexisting token in session" useOldToken
|
||||||
, it "generates a new token for sessions without token" generateToken
|
it "generates a new token for sessions without token" generateToken
|
||||||
]
|
|
||||||
|
|
||||||
noDisabledToken :: Bool
|
noDisabledToken :: Bool
|
||||||
noDisabledToken = reqToken r == Nothing where
|
noDisabledToken = reqToken r == Nothing where
|
||||||
@ -56,13 +54,12 @@ generateToken = reqToken r /= Nothing where
|
|||||||
|
|
||||||
|
|
||||||
langSpecs :: Spec
|
langSpecs :: Spec
|
||||||
langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)"
|
langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)" $ do
|
||||||
[ it "respects Accept-Language" respectAcceptLangs
|
it "respects Accept-Language" respectAcceptLangs
|
||||||
, it "respects sessions" respectSessionLang
|
it "respects sessions" respectSessionLang
|
||||||
, it "respects cookies" respectCookieLang
|
it "respects cookies" respectCookieLang
|
||||||
, it "respects queries" respectQueryLang
|
it "respects queries" respectQueryLang
|
||||||
, it "prioritizes correctly" prioritizeLangs
|
it "prioritizes correctly" prioritizeLangs
|
||||||
]
|
|
||||||
|
|
||||||
respectAcceptLangs :: Bool
|
respectAcceptLangs :: Bool
|
||||||
respectAcceptLangs = reqLangs r == ["en-US", "es", "en"] where
|
respectAcceptLangs = reqLangs r == ["en-US", "es", "en"] where
|
||||||
@ -94,8 +91,7 @@ prioritizeLangs = reqLangs r == ["en-QUERY", "en-COOKIE", "en-SESSION", "en", "e
|
|||||||
|
|
||||||
|
|
||||||
internalRequestTest :: Spec
|
internalRequestTest :: Spec
|
||||||
internalRequestTest = describe "Test.InternalRequestTest"
|
internalRequestTest = describe "Test.InternalRequestTest" $ do
|
||||||
[ randomStringSpecs
|
randomStringSpecs
|
||||||
, tokenSpecs
|
tokenSpecs
|
||||||
, langSpecs
|
langSpecs
|
||||||
]
|
|
||||||
|
|||||||
@ -23,19 +23,18 @@ getHeadR :: Handler RepHtml
|
|||||||
getHeadR = defaultLayout $ addScriptRemote "load.js"
|
getHeadR = defaultLayout $ addScriptRemote "load.js"
|
||||||
|
|
||||||
specs :: Spec
|
specs :: Spec
|
||||||
specs = describe "Test.JsLoader" [
|
specs = describe "Test.JsLoader" $ do
|
||||||
it "link from head" $ runner H $ do
|
it "link from head" $ runner H $ do
|
||||||
res <- request defaultRequest
|
res <- request defaultRequest
|
||||||
assertBody "<!DOCTYPE html>\n<html><head><title></title><script src=\"load.js\"></script></head><body></body></html>" res
|
assertBody "<!DOCTYPE html>\n<html><head><title></title><script src=\"load.js\"></script></head><body></body></html>" res
|
||||||
|
|
||||||
, it "link from head async" $ runner HA $ do
|
it "link from head async" $ runner HA $ do
|
||||||
res <- request defaultRequest
|
res <- request defaultRequest
|
||||||
assertBody "<!DOCTYPE html>\n<html><head><title></title><script src=\"yepnope.js\"></script><script>yepnope({load:[\"load.js\"]});</script></head><body></body></html>" res
|
assertBody "<!DOCTYPE html>\n<html><head><title></title><script src=\"yepnope.js\"></script><script>yepnope({load:[\"load.js\"]});</script></head><body></body></html>" res
|
||||||
|
|
||||||
, it "link from bottom" $ runner B $ do
|
it "link from bottom" $ runner B $ do
|
||||||
res <- request defaultRequest
|
res <- request defaultRequest
|
||||||
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script src=\"load.js\"></script></body></html>" res
|
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script src=\"load.js\"></script></body></html>" res
|
||||||
]
|
|
||||||
|
|
||||||
runner :: (YesodDispatch master master, Yesod master) => master -> Session () -> IO ()
|
runner :: (YesodDispatch master master, Yesod master) => master -> Session () -> IO ()
|
||||||
runner app f = toWaiApp app >>= runSession f
|
runner app f = toWaiApp app >>= runSession f
|
||||||
|
|||||||
@ -21,9 +21,8 @@ getRootR :: Handler RepHtml
|
|||||||
getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|]
|
getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|]
|
||||||
|
|
||||||
linksTest :: Spec
|
linksTest :: Spec
|
||||||
linksTest = describe "Test.Links"
|
linksTest = describe "Test.Links" $ do
|
||||||
[ it "linkToHome" case_linkToHome
|
it "linkToHome" case_linkToHome
|
||||||
]
|
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
runner f = toWaiApp Y >>= runSession f
|
runner f = toWaiApp Y >>= runSession f
|
||||||
|
|||||||
@ -50,7 +50,6 @@ caseMediaLink = runner $ do
|
|||||||
flip assertBody res "<!DOCTYPE html>\n<html><head><title></title><link rel=\"stylesheet\" href=\"all.css\"><link rel=\"stylesheet\" media=\"screen\" href=\"screen.css\"></head><body></body></html>"
|
flip assertBody res "<!DOCTYPE html>\n<html><head><title></title><link rel=\"stylesheet\" href=\"all.css\"><link rel=\"stylesheet\" media=\"screen\" href=\"screen.css\"></head><body></body></html>"
|
||||||
|
|
||||||
mediaTest :: Spec
|
mediaTest :: Spec
|
||||||
mediaTest = describe "Test.Media"
|
mediaTest = describe "Test.Media" $ do
|
||||||
[ it "media" caseMedia
|
it "media" caseMedia
|
||||||
, it "media link" caseMediaLink
|
it "media link" caseMediaLink
|
||||||
]
|
|
||||||
|
|||||||
@ -45,6 +45,5 @@ case_sanity = runner $ do
|
|||||||
assertBody mempty res
|
assertBody mempty res
|
||||||
|
|
||||||
noOverloadedTest :: Spec
|
noOverloadedTest :: Spec
|
||||||
noOverloadedTest = describe "Test.NoOverloadedStrings"
|
noOverloadedTest = describe "Test.NoOverloadedStrings" $ do
|
||||||
[ it "sanity" case_sanity
|
it "sanity" case_sanity
|
||||||
]
|
|
||||||
|
|||||||
@ -27,33 +27,32 @@ getR307 = redirectWith H.status307 RootR
|
|||||||
getRRegular = redirect RootR
|
getRRegular = redirect RootR
|
||||||
|
|
||||||
specs :: Spec
|
specs :: Spec
|
||||||
specs = describe "Redirect" [
|
specs = describe "Redirect" $ do
|
||||||
it "301 redirect" $ app $ do
|
it "301 redirect" $ app $ do
|
||||||
res <- request defaultRequest { pathInfo = ["r301"] }
|
res <- request defaultRequest { pathInfo = ["r301"] }
|
||||||
assertStatus 301 res
|
assertStatus 301 res
|
||||||
assertBodyContains "" res
|
assertBodyContains "" res
|
||||||
|
|
||||||
, it "303 redirect" $ app $ do
|
it "303 redirect" $ app $ do
|
||||||
res <- request defaultRequest { pathInfo = ["r303"] }
|
res <- request defaultRequest { pathInfo = ["r303"] }
|
||||||
assertStatus 303 res
|
assertStatus 303 res
|
||||||
assertBodyContains "" res
|
assertBodyContains "" res
|
||||||
|
|
||||||
, it "307 redirect" $ app $ do
|
it "307 redirect" $ app $ do
|
||||||
res <- request defaultRequest { pathInfo = ["r307"] }
|
res <- request defaultRequest { pathInfo = ["r307"] }
|
||||||
assertStatus 307 res
|
assertStatus 307 res
|
||||||
assertBodyContains "" res
|
assertBodyContains "" res
|
||||||
|
|
||||||
, it "303 redirect for regular, HTTP 1.1" $ app $ do
|
it "303 redirect for regular, HTTP 1.1" $ app $ do
|
||||||
res <- request defaultRequest {
|
res <- request defaultRequest {
|
||||||
pathInfo = ["rregular"]
|
pathInfo = ["rregular"]
|
||||||
}
|
}
|
||||||
assertStatus 303 res
|
assertStatus 303 res
|
||||||
assertBodyContains "" res
|
assertBodyContains "" res
|
||||||
, it "302 redirect for regular, HTTP 1.0" $ app $ do
|
it "302 redirect for regular, HTTP 1.0" $ app $ do
|
||||||
res <- request defaultRequest {
|
res <- request defaultRequest {
|
||||||
pathInfo = ["rregular"]
|
pathInfo = ["rregular"]
|
||||||
, httpVersion = H.http10
|
, httpVersion = H.http10
|
||||||
}
|
}
|
||||||
assertStatus 302 res
|
assertStatus 302 res
|
||||||
assertBodyContains "" res
|
assertBodyContains "" res
|
||||||
]
|
|
||||||
|
|||||||
@ -26,14 +26,13 @@ getRootR :: Handler ()
|
|||||||
getRootR = return ()
|
getRootR = return ()
|
||||||
|
|
||||||
specs :: Spec
|
specs :: Spec
|
||||||
specs = describe "WaiSubsite" [
|
specs = describe "WaiSubsite" $ do
|
||||||
it "root" $ app $ do
|
it "root" $ app $ do
|
||||||
res <- request defaultRequest { pathInfo = [] }
|
res <- request defaultRequest { pathInfo = [] }
|
||||||
assertStatus 200 res
|
assertStatus 200 res
|
||||||
assertBodyContains "" res
|
assertBodyContains "" res
|
||||||
|
|
||||||
, it "subsite" $ app $ do
|
it "subsite" $ app $ do
|
||||||
res <- request defaultRequest { pathInfo = ["sub", "foo"] }
|
res <- request defaultRequest { pathInfo = ["sub", "foo"] }
|
||||||
assertStatus 200 res
|
assertStatus 200 res
|
||||||
assertBodyContains "WAI" res
|
assertBodyContains "WAI" res
|
||||||
]
|
|
||||||
|
|||||||
@ -87,13 +87,12 @@ getJSHeadR :: Handler RepHtml
|
|||||||
getJSHeadR = defaultLayout $ toWidgetHead [julius|alert("hello");|]
|
getJSHeadR = defaultLayout $ toWidgetHead [julius|alert("hello");|]
|
||||||
|
|
||||||
widgetTest :: Spec
|
widgetTest :: Spec
|
||||||
widgetTest = describe "Test.Widget"
|
widgetTest = describe "Test.Widget" $ do
|
||||||
[ it "addJuliusBody" case_addJuliusBody
|
it "addJuliusBody" case_addJuliusBody
|
||||||
, it "whamlet" case_whamlet
|
it "whamlet" case_whamlet
|
||||||
, it "two letter lang codes" case_two_letter_lang
|
it "two letter lang codes" case_two_letter_lang
|
||||||
, it "automatically applies toWidget" case_auto
|
it "automatically applies toWidget" case_auto
|
||||||
, it "toWidgetHead puts JS in head" case_jshead
|
it "toWidgetHead puts JS in head" case_jshead
|
||||||
]
|
|
||||||
|
|
||||||
runner :: Session () -> IO ()
|
runner :: Session () -> IO ()
|
||||||
runner f = toWaiApp Y >>= runSession f
|
runner f = toWaiApp Y >>= runSession f
|
||||||
|
|||||||
@ -108,7 +108,7 @@ test-suite tests
|
|||||||
|
|
||||||
cpp-options: -DTEST
|
cpp-options: -DTEST
|
||||||
build-depends: base
|
build-depends: base
|
||||||
,hspec >= 1.2 && < 1.3
|
,hspec >= 1.3 && < 1.4
|
||||||
,wai-test
|
,wai-test
|
||||||
,wai
|
,wai
|
||||||
,yesod-core
|
,yesod-core
|
||||||
|
|||||||
@ -42,7 +42,7 @@ test-suite runtests
|
|||||||
, yesod-routes
|
, yesod-routes
|
||||||
, text >= 0.5 && < 0.12
|
, text >= 0.5 && < 0.12
|
||||||
, HUnit >= 1.2 && < 1.3
|
, HUnit >= 1.2 && < 1.3
|
||||||
, hspec >= 1.2 && < 1.3
|
, hspec >= 1.3 && < 1.4
|
||||||
, containers
|
, containers
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, path-pieces
|
, path-pieces
|
||||||
|
|||||||
@ -6,11 +6,9 @@ import Test.Hspec.HUnit ( )
|
|||||||
|
|
||||||
import Yesod.Static (getFileListPieces)
|
import Yesod.Static (getFileListPieces)
|
||||||
|
|
||||||
specs :: Specs
|
specs :: Spec
|
||||||
specs = [
|
specs = do
|
||||||
describe "get file list" [
|
describe "get file list" $ do
|
||||||
it "pieces" $ do
|
it "pieces" $ do
|
||||||
x <- getFileListPieces "test/fs"
|
x <- getFileListPieces "test/fs"
|
||||||
x @?= [["foo"], ["bar", "baz"]]
|
x @?= [["foo"], ["bar", "baz"]]
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|||||||
@ -4,4 +4,4 @@ import Test.Hspec
|
|||||||
import YesodStaticTest (specs)
|
import YesodStaticTest (specs)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspecX specs
|
main = hspec specs
|
||||||
|
|||||||
@ -45,7 +45,7 @@ test-suite tests
|
|||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
cpp-options: -DTEST_EXPORT
|
cpp-options: -DTEST_EXPORT
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, hspec >= 1.2 && < 1.3
|
, hspec >= 1.3 && < 1.4
|
||||||
, HUnit
|
, HUnit
|
||||||
-- copy from above
|
-- copy from above
|
||||||
, containers >= 0.2
|
, containers >= 0.2
|
||||||
|
|||||||
@ -316,19 +316,6 @@ nameFromLabel label = withResponse $ \ res -> do
|
|||||||
(<>) :: T.Text -> T.Text -> T.Text
|
(<>) :: T.Text -> T.Text -> T.Text
|
||||||
(<>) = T.append
|
(<>) = T.append
|
||||||
|
|
||||||
-- | Escape HTML entities in a string, so you can write the text you want in
|
|
||||||
-- label lookups without worrying about the fact that yesod escapes some characters.
|
|
||||||
escapeHtmlEntities :: T.Text -> T.Text
|
|
||||||
escapeHtmlEntities =
|
|
||||||
T.concatMap go
|
|
||||||
where
|
|
||||||
go '<' = "<"
|
|
||||||
go '>' = ">"
|
|
||||||
go '&' = "&"
|
|
||||||
go '"' = """
|
|
||||||
go '\'' = "'"
|
|
||||||
go x = T.singleton x
|
|
||||||
|
|
||||||
byLabel :: T.Text -> T.Text -> RequestBuilder ()
|
byLabel :: T.Text -> T.Text -> RequestBuilder ()
|
||||||
byLabel label value = do
|
byLabel label value = do
|
||||||
name <- nameFromLabel label
|
name <- nameFromLabel label
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user