Test runtime log does not contain errors

swarm-game · Aug 24, 2023 · 606bc8f · 606bc8f
1 parent d0783bc
commit 606bc8f
Showing 1 changed file with 35 additions and 7 deletions.
diff --git a/test/integration/Main.hs b/test/integration/Main.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 -- |
 -- SPDX-License-Identifier: BSD-3-Clause
@@ -31,7 +31,8 @@ import Swarm.Doc.Gen qualified as DocGen
 import Swarm.Game.CESK (emptyStore, getTickNumber, initMachine)
 import Swarm.Game.Entity (EntityMap, lookupByName)
 import Swarm.Game.Failure (SystemFailure)
-import Swarm.Game.Robot (LogEntry, defReqs, equippedDevices, leText, machine, robotContext, robotLog, systemRobot, waitingUntil)
+import Swarm.Game.Log (ErrorLevel (..), LogEntry, LogSource (..), leSource, leText)
+import Swarm.Game.Robot (defReqs, equippedDevices, machine, robotContext, robotLog, systemRobot, waitingUntil)
 import Swarm.Game.Scenario (Scenario)
 import Swarm.Game.State (
   GameState,
@@ -40,6 +41,7 @@ import Swarm.Game.State (
   activeRobots,
   baseRobot,
   messageQueue,
+  notificationsContent,
   robotMap,
   ticks,
   waitingRobots,
@@ -51,7 +53,16 @@ import Swarm.Game.World.Typecheck (WorldMap)
 import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Pipeline (ProcessedTerm (..), processTerm)
 import Swarm.Language.Pretty (prettyString)
-import Swarm.TUI.Model (RuntimeState, defaultAppOpts, gameState, stdEntityMap, userScenario, worlds)
+import Swarm.TUI.Model (
+  RuntimeState,
+  defaultAppOpts,
+  eventLog,
+  gameState,
+  runtimeState,
+  stdEntityMap,
+  userScenario,
+  worlds,
+ )
 import Swarm.TUI.Model.StateUpdate (constructAppState, initPersistentState)
 import Swarm.TUI.Model.UI (UIState)
 import Swarm.Util (acquireAllWithExt)
@@ -75,17 +86,33 @@ main = do
     out <- runM . runThrow @SystemFailure $ initPersistentState defaultAppOpts
     either (assertFailure . prettyString) return out
   let em = rs ^. stdEntityMap
+  let rs' = rs & eventLog .~ mempty
   defaultMain $
     testGroup
       "Tests"
-      [ exampleTests examplePaths
+      [ testNoLoadingErrors rs
+      , exampleTests examplePaths
       , exampleTests scenarioPrograms
       , scenarioParseTests em (rs ^. worlds) parseableScenarios
       , scenarioParseInvalidTests em (rs ^. worlds) unparseableScenarios
-      , testScenarioSolutions rs ui
+      , testScenarioSolutions rs' ui
       , testEditorFiles
       ]
 
+testNoLoadingErrors :: RuntimeState -> TestTree
+testNoLoadingErrors r =
+  testCase "Test runtime log does not contain errors" (checkNoRuntimeErrors r)
+
+checkNoRuntimeErrors :: RuntimeState -> IO ()
+checkNoRuntimeErrors r =
+  forM_ (r ^. eventLog . notificationsContent) $ \e ->
+    case e ^. leSource of
+      ErrorTrace l
+        | l >= Warning ->
+            assertFailure $
+              show l <> " was produced during loading: " <> T.unpack (e ^. leText)
+      _ -> pure ()
+
 exampleTests :: [(FilePath, String)] -> TestTree
 exampleTests inputs = testGroup "Test example" (map exampleTest inputs)
 
@@ -325,11 +352,12 @@ testScenarioSolutions rs ui =
     out <- runM . runThrow @SystemFailure $ constructAppState rs ui $ defaultAppOpts {userScenario = Just p}
     case out of
       Left err -> assertFailure $ prettyString err
-      Right (view gameState -> gs) -> case gs ^. winSolution of
+      Right appState -> case appState ^. gameState . winSolution of
         Nothing -> assertFailure "No solution to test!"
         Just sol@(ProcessedTerm _ _ reqCtx) -> do
+          when (shouldCheckBadErrors == CheckForBadErrors) (checkNoRuntimeErrors $ appState ^. runtimeState)
           let gs' =
-                gs
+                (appState ^. gameState)
                   -- See #827 for an explanation of why it's important to add to
                   -- the robotContext defReqs here (and also why this will,
                   -- hopefully, eventually, go away).