diff --git a/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs b/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs index dd0af2671..db1d8ee3e 100644 --- a/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs +++ b/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs @@ -101,9 +101,12 @@ requirements tdCtx ctx = add (singletonCap CLambda) mapM_ typeRequirements mty local @ReqCtx (Ctx.delete x) $ go t - -- An application simply requires the union of the capabilities - -- from the left- and right-hand sides. This assumes that the - -- argument will be used at least once by the function. + -- Special case for 'use' with a device literal. + TApp t1@(TConst Use) t2@(TText device) -> + add (singletonDev device) *> go t1 *> go t2 + -- In general, an application simply requires the union of the + -- capabilities from the left- and right-hand sides. This assumes + -- that the argument will be used at least once by the function. TApp t1 t2 -> go t1 *> go t2 -- Similarly, for a let, we assume that the let-bound expression -- will be used at least once in the body. We delete the let-bound diff --git a/test/unit/TestRequirements.hs b/test/unit/TestRequirements.hs index 25c6cc9c6..e2063c9dc 100644 --- a/test/unit/TestRequirements.hs +++ b/test/unit/TestRequirements.hs @@ -13,7 +13,7 @@ import Swarm.Language.Capability import Swarm.Language.Context qualified as Ctx import Swarm.Language.Pipeline import Swarm.Language.Requirements.Analysis (requirements) -import Swarm.Language.Requirements.Type (ReqCtx, Requirements, capReqs) +import Swarm.Language.Requirements.Type (ReqCtx, Requirements, capReqs, devReqs) import Swarm.Language.Syntax.Constants (Const (Move)) import Swarm.Language.Syntax.Util (eraseS) import Test.Tasty @@ -39,6 +39,11 @@ testRequirements = "def m = move end; def y = \\m. log (format m) end" (maybe False ((CExecute Move `S.notMember`) . capReqs) . Ctx.lookup "y") ] + , testGroup + "use" + [ testCase "literal argument to use (#1301)" $ + "use \"key\"" `requiresDev` "key" + ] ] checkReqCtx :: Text -> (ReqCtx -> Bool) -> Assertion @@ -49,3 +54,6 @@ checkRequirements code expect = check code (expect . requirements mempty mempty requiresCap :: Text -> Capability -> Assertion requiresCap code cap = checkRequirements code ((cap `S.member`) . capReqs) + +requiresDev :: Text -> Text -> Assertion +requiresDev code dev = checkRequirements code ((dev `S.member`) . devReqs)