hspec 1.3

This commit is contained in:
Michael Snoyman 2012-08-03 15:40:36 +03:00
parent 60b7111529
commit df5018a94c
21 changed files with 83 additions and 114 deletions

@ -1 +1 @@
Subproject commit eba05a0b5fe121883969f8fa9b7f7669592430a4 Subproject commit bf06d8e764f3d2931c0a676dc5c6fc14491b012a

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -4,4 +4,4 @@ import Test.Hspec
import YesodStaticTest (specs) import YesodStaticTest (specs)
main :: IO () main :: IO ()
main = hspecX specs main = hspec specs

View File

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

View File

@ -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 '<' = "&lt;"
go '>' = "&gt;"
go '&' = "&amp;"
go '"' = "&quot;"
go '\'' = "&#39;"
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