copy parent robot context to child when executing build

Fixes #394.
swarm-game · Nov 2, 2022 · 7a198a0 · 7a198a0
1 parent ca6a4e1
commit 7a198a0
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 5 deletions.
diff --git a/data/scenarios/Testing/394-build-drill.yaml b/data/scenarios/Testing/394-build-drill.yaml
@@ -18,7 +18,14 @@ solution: |
   r <- build {
     wait 2;
     log "Hi, I am builder";
-    forever (build {log "Hi, I am pusher"; turn forward; forever push}; log "- robot built")
+    forever (
+      build {
+        log "Hi, I am pusher";
+        require "drill";          // #540
+        forever push
+      };
+      log "- robot built"
+    )
   };
   wait 10;
   place "detonator";

diff --git a/src/Swarm/Game/Robot.hs b/src/Swarm/Game/Robot.hs
@@ -60,6 +60,7 @@ module Swarm.Game.Robot (
   inventoryHash,
   robotCapabilities,
   robotContext,
+  trobotContext,
   robotID,
   robotParentID,
   robotHeavy,
@@ -322,9 +323,13 @@ robotOrientation = robotEntity . entityOrientation
 robotInventory :: Lens' Robot Inventory
 robotInventory = robotEntity . entityInventory
 
--- | The robot's context
+-- | The robot's context.
 robotContext :: Lens' Robot RobotContext
 
+-- | The robot's context.
+trobotContext :: Lens' TRobot RobotContext
+trobotContext = lens _robotContext (\r c -> r {_robotContext = c})
+
 -- | The (unique) ID number of the robot.  This is only a Getter since
 --   the robot ID is immutable.
 robotID :: Getter Robot RID

diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs
@@ -1339,8 +1339,9 @@ execConst c vs s k = do
         createdAt <- getNow
 
         -- Construct the new robot and add it to the world.
+        parentCtx <- use robotContext
         newRobot <-
-          addTRobot $
+          addTRobot . (trobotContext .~ parentCtx) $
             mkRobot
               ()
               (Just pid)

diff --git a/test/integration/Main.hs b/test/integration/Main.hs
@@ -169,8 +169,7 @@ testScenarioSolution _ci _em =
         ]
     , testGroup
         "Regression tests"
-        [ expectFailBecause "Awaiting fix (#394)" $
-            testSolution Default "Testing/394-build-drill"
+        [ testSolution Default "Testing/394-build-drill"
         , testSolution Default "Testing/373-drill"
         , testSolution Default "Testing/428-drowning-destroy"
         , testSolution' Default "Testing/475-wait-one" $ \g -> do