haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix quote ' not matching in any body

Browse Source 
This sometimes occured in our code base when generating
names with the fakedata package, someone named o'conner
randomly fails a particular test.

Also add tests for the other matching function and fixed them.

Furthermore, I snuck in logging of the matches as well.
This commit is contained in:
Jappie Klooster 2022-05-10 15:51:18 -04:00
parent 0a273d5aae
commit 28fc2269b0
3 changed files with 24 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
yesod-test/Yesod/Test.hs
View File

@ -241,6 +241,8 @@ import qualified Network.Socket.Internal as Sock
import Data.CaseInsensitive (CI) import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import qualified Text.Blaze.Renderer.String as Blaze
import qualified Text.Blaze as Blaze
import Network.Wai import Network.Wai
import Network.Wai.Test hiding (assertHeader, assertNoHeader, request) import Network.Wai.Test hiding (assertHeader, assertNoHeader, request)
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -708,8 +710,13 @@ htmlAllContain query search = do
matches <- htmlQuery query matches <- htmlQuery query
case matches of case matches of
[] -> failure $ "Nothing matched css query: " <> query [] -> failure $ "Nothing matched css query: " <> query
_ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search) $ _ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search ++ " matches: " ++ show matches) $
DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) DL.all (DL.isInfixOf (escape search)) (map (TL.unpack . decodeUtf8) matches)
-- | puts the search trough the same escaping as the matches are.
-- this helps with matching on special characters
escape :: String -> String
escape = Blaze.renderMarkup . Blaze.string
-- | Queries the HTML using a CSS selector, and passes if any matched -- | Queries the HTML using a CSS selector, and passes if any matched
-- element contains the given string. -- element contains the given string.
@ -726,8 +733,8 @@ htmlAnyContain query search = do
matches <- htmlQuery query matches <- htmlQuery query
case matches of case matches of
[] -> failure $ "Nothing matched css query: " <> query [] -> failure $ "Nothing matched css query: " <> query
_ -> liftIO $ HUnit.assertBool ("None of "++T.unpack query++" contain "++search) $ _ -> liftIO $ HUnit.assertBool ("None of "++T.unpack query++" contain "++search ++ " matches: " ++ show matches) $
DL.any (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) DL.any (DL.isInfixOf (escape search)) (map (TL.unpack . decodeUtf8) matches)
-- | Queries the HTML using a CSS selector, and fails if any matched -- | Queries the HTML using a CSS selector, and fails if any matched
-- element contains the given string (in other words, it is the logical -- element contains the given string (in other words, it is the logical
@ -743,7 +750,7 @@ htmlAnyContain query search = do
htmlNoneContain :: HasCallStack => Query -> String -> YesodExample site () htmlNoneContain :: HasCallStack => Query -> String -> YesodExample site ()
htmlNoneContain query search = do htmlNoneContain query search = do
matches <- htmlQuery query matches <- htmlQuery query
case DL.filter (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) of case DL.filter (DL.isInfixOf (escape search)) (map (TL.unpack . decodeUtf8) matches) of
[] -> return () [] -> return ()
found -> failure $ "Found " <> T.pack (show $ length found) <> found -> failure $ "Found " <> T.pack (show $ length found) <>
" instances of " <> T.pack search <> " in " <> query <> " elements" " instances of " <> T.pack search <> " in " <> query <> " elements"

13
yesod-test/test/main.hs
View File

@ -36,6 +36,7 @@ import Network.Wai.Test (SResponse(simpleBody))
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Either (isLeft, isRight) import Data.Either (isLeft, isRight)
import Test.HUnit.Lang
import Data.ByteString.Lazy.Char8 () import Data.ByteString.Lazy.Char8 ()
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Text.HTML.DOM as HD import qualified Text.HTML.DOM as HD
@ -202,9 +203,17 @@ main = hspec $ do
statusIs 200 statusIs 200
htmlCount "p" 2 htmlCount "p" 2
htmlAllContain "p" "Hello" htmlAllContain "p" "Hello"
htmlAllContain "span" "O'Kon"
htmlAnyContain "p" "World" htmlAnyContain "p" "World"
htmlAnyContain "p" "Moon" htmlAnyContain "p" "Moon"
htmlAnyContain "p" "O'Kon"
htmlNoneContain "p" "Sun" htmlNoneContain "p" "Sun"
-- we found it so we know the
-- matching on quotes works for NoneContain
withRunInIO $ \runInIO ->
shouldThrow (runInIO (htmlNoneContain "span" "O'Kon"))
(\case HUnitFailure _ _ -> True)
yit "finds the CSRF token by css selector" $ do yit "finds the CSRF token by css selector" $ do
get ("/form" :: Text) get ("/form" :: Text)
statusIs 200 statusIs 200
@ -221,7 +230,7 @@ main = hspec $ do
get ("/htmlWithLink" :: Text) get ("/htmlWithLink" :: Text)
clickOn "a#thelink" clickOn "a#thelink"
statusIs 200 statusIs 200
bodyEquals "<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>" bodyEquals "<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon and <span>O'Kon</span></p></body></html>"
get ("/htmlWithLink" :: Text) get ("/htmlWithLink" :: Text)
bad <- tryAny (clickOn "a#nonexistentlink") bad <- tryAny (clickOn "a#nonexistentlink")
@ -555,7 +564,7 @@ app = liteApp $ do
FormSuccess (foo, _) -> return $ toHtml foo FormSuccess (foo, _) -> return $ toHtml foo
_ -> defaultLayout widget _ -> defaultLayout widget
onStatic "html" $ dispatchTo $ onStatic "html" $ dispatchTo $
return ("<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>" :: Text) return ("<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon and <span>O'Kon</span></p></body></html>" :: Text)
onStatic "htmlWithLink" $ dispatchTo $ onStatic "htmlWithLink" $ dispatchTo $
return ("<html><head><title>A link</title></head><body><a href=\"/html\" id=\"thelink\">Link!</a></body></html>" :: Text) return ("<html><head><title>A link</title></head><body><a href=\"/html\" id=\"thelink\">Link!</a></body></html>" :: Text)

1
yesod-test/yesod-test.cabal
View File

@ -41,6 +41,7 @@ library
, xml-conduit >= 1.0 , xml-conduit >= 1.0
, xml-types >= 0.3 , xml-types >= 0.3
, yesod-core >= 1.6.17 , yesod-core >= 1.6.17
, blaze-markup
exposed-modules: Yesod.Test exposed-modules: Yesod.Test
Yesod.Test.CssQuery Yesod.Test.CssQuery