ErrorHandlingBug (from Aur)

This commit is contained in:
Michael Snoyman 2011-10-06 16:22:21 +02:00
parent e5426f8696
commit 35274e4859
3 changed files with 103 additions and 2 deletions

View File

@ -0,0 +1,98 @@
{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
module Test.ErrorHandling
( errorHandlingTest
, Widget
) where
import Yesod.Core
import Test.Hspec
import Test.Hspec.HUnit()
import Network.Wai
import Network.Wai.Test
import Text.Hamlet (hamlet)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as S8
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/not_found NotFoundR POST
/first_thing FirstThingR POST
/after_runRequestBody AfterRunRequestBodyR POST
|]
instance Yesod App where approot _ = ""
getHomeR :: Handler RepHtml
getHomeR = defaultLayout $ toWidget [hamlet|
!!!
<html>
<body>
<form method=post action=@{NotFoundR}>
<input type=submit value="Not found">
<form method=post action=@{FirstThingR}>
<input type=submit value="Error is thrown first thing in handler">
<form method=post action=@{AfterRunRequestBodyR}>
<input type=submit value="BUGGY: Error thrown after runRequestBody">
|]
postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml
postNotFoundR = do
(_, _files) <- runRequestBody
_ <- notFound
getHomeR
postFirstThingR = do
_ <- error "There was an error 3.14159"
getHomeR
postAfterRunRequestBodyR = do
x <- runRequestBody
_ <- error $ show x
getHomeR
errorHandlingTest :: [Spec]
errorHandlingTest = describe "Test.ErrorHandling"
[ it "says not found" caseNotFound
, it "says 'There was an error' before runRequestBody" caseBefore
, it "says 'There was an error' after runRequestBody" caseAfter
]
runner :: Session () -> IO ()
runner f = toWaiApp App >>= runSession f
caseNotFound :: IO ()
caseNotFound = runner $ do
res <- request defaultRequest
{ pathInfo = ["not_found"]
, requestMethod = "POST"
}
assertStatus 404 res
assertBodyContains "Not Found" res
caseBefore :: IO ()
caseBefore = runner $ do
res <- request defaultRequest
{ pathInfo = ["first_thing"]
, requestMethod = "POST"
}
assertStatus 500 res
assertBodyContains "There was an error 3.14159" res
caseAfter :: IO ()
caseAfter = runner $ do
let content = "foo=bar&baz=bin12345"
res <- srequest SRequest
{ simpleRequest = defaultRequest
{ pathInfo = ["after_runRequestBody"]
, requestMethod = "POST"
, requestHeaders =
[ ("content-type", "application/x-www-form-urlencoded")
, ("content-length", S8.pack $ show $ L.length content)
]
}
, simpleRequestBody = content
}
assertStatus 500 res
assertBodyContains "There was an error 2.71828" res

View File

@ -7,6 +7,7 @@ import Test.Media
import Test.Links
import Test.NoOverloadedStrings
import Test.InternalRequest
import Test.ErrorHandling
main :: IO ()
main = hspecX $ descriptions $
@ -17,4 +18,5 @@ main = hspecX $ descriptions $
, linksTest
, noOverloadedTest
, internalRequestTest
, errorHandlingTest
]

View File

@ -23,6 +23,7 @@ extra-source-files:
test/Test/CleanPath.hs
test/Test/Links.hs
test/Test/InternalRequest.hs
test/Test/ErrorHandling.hs
test/main.hs
flag test
@ -107,8 +108,8 @@ test-suite runtests
build-depends: base >= 4 && < 4.3
main-is: main.hs
cpp-options: -DTEST
build-depends: hspec >= 0.8 && < 0.9
,wai-test
build-depends: hspec >= 0.8 && < 0.10
,wai-test >= 0.1.2 && < 0.2
,wai
,yesod-core
,bytestring