1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
module HandleHumanLocalMUnitTests (handleHumanLocalMUnitTests) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import Test.Tasty
import Test.Tasty.HUnit
import Game.LambdaHack.Client.UI (SessionUI (..), modifySession)
import Game.LambdaHack.Client.UI.HandleHelperM
import Game.LambdaHack.Client.UI.HandleHumanLocalM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.TutorialHints
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemAspect
import Game.LambdaHack.Common.Kind (emptyMultiGroupItem)
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import Game.LambdaHack.Content.TileKind
import Game.LambdaHack.Definition.DefsInternal
(toContentId, toContentSymbol)
import UnitTestHelpers
testItemFull :: ItemFull
testItemFull = ItemFull { itemBase = stubItem, itemKindId = toContentId 0, itemKind = emptyMultiGroupItem, itemDisco = ItemDiscoFull emptyAspectRecord, itemSuspect = False }
handleHumanLocalMUnitTests :: TestTree
handleHumanLocalMUnitTests = testGroup "handleHumanLocalMUnitTests"
[ testCase "verify stubLevel has tile element" $
case EM.lookup testLevelId (sdungeon stubState) of
Nothing -> assertFailure "stubLevel lost in dungeon"
Just level -> ltile level ! Point 0 0 @?= unknownId
, testCase "verify stubCliState has actor" $
getActorBody testActorId (cliState stubCliState) @?= testActor
, testCase "permittedProjectClient stubCliState returns ProjectUnskilled" $ do
let testFn = permittedProjectClient testActorId
permittedProjectClientResultFnInMonad <- executorCli testFn stubCliState
let ultimateResult =
fst permittedProjectClientResultFnInMonad testItemFull
ultimateResult @?= Left ProjectUnskilled
, testCase "chooseItemProjectHuman" $ do
let testFn = let triggerItems =
[ HumanCmd.TriggerItem {tiverb = "verb", tiobject = "object", tisymbols = [toContentSymbol 'a', toContentSymbol 'b']}
, HumanCmd.TriggerItem {tiverb = "verb2", tiobject = "object2", tisymbols = [toContentSymbol 'c']}
]
in chooseItemProjectHuman testActorId triggerItems
result <- executorCli testFn testCliStateWithItem
showFailError (fromJust (fst result)) @?= "*aiming obstructed by terrain*"
, testCase "tutorialHints-msg-in-history-report" $ do
let testFn = do
modifySession (\sess -> sess {scurTutorial = True})
-- permit the client not to ignore tutorial hints
tutorialHintMsgAdd CannotHarmYouInMelee
result <- executorCli testFn testCliStateWithItem
let maybeHistory = shistory <$> (cliSession . snd) result
case maybeHistory of
Nothing -> assertFailure "History is empty"
Just history -> assertBool testFailureMsg isHintThere
where
renderedNewReports = reportToTexts . newReport $ history
renderedHint = renderTutorialHints CannotHarmYouInMelee
isHintThere = renderedHint `elem` renderedNewReports
testFailureMsg = "Expected to find tutorial hint '"
<> (T.unpack . renderTutorialHints $ CannotHarmYouInMelee)
<> "' in SessionUI.shistory.newReport '"
<> T.unpack (T.unlines renderedNewReports)
<> "'"
, testCase "psuitReq" $ do
let testFn = psuitReq testActorId
mpsuitReqMonad <- executorCli testFn testCliStateWithItem
let mpsuitReq = fst mpsuitReqMonad
case mpsuitReq of
Left err -> do
err @?= "aiming obstructed by terrain"
-- TODO: I'd split the test into three tests, each taking a different branch and fail in the remaining two branches that the particular branch doesn't take. Here it takes the first branch, because unknown tiles are not walkable (regardless what I claimed previously) and so the player is surrounded by walls, basically, so aiming fails, because the projectiles wouldn't even leave the position of the actor. I think.
Right psuitReqFun ->
case psuitReqFun testItemFull of
Left reqFail -> do
reqFail @?= ProjectUnskilled
Right (pos, _) -> do
pos @?= Point 0 0
, testCase "xhairLegalEps" $ do
let testFn = xhairLegalEps testActorId
result <- executorCli testFn testCliStateWithItem
fst result @?= Right 114 -- not a coincidence this matches testFactionId,
-- because @eps@ is initialized that way,
-- for "randomness"
]
|
