Fix recursion check in direct style interpreter

Author: jmcardon

pact-repl/Pact/Core/IR/Eval/Direct/Evaluator.hs

@@ -649,13 +649,15 @@ sysOnlyEnv e
 
 evalWithStackFrame :: i -> StackFrame i -> Maybe Type -> EvalM e b i (EvalValue e b i) -> EvalM e b i (EvalValue e b i)
 evalWithStackFrame info sf mty act = do
+  checkRecursion
   esStack %= (sf:)
 #ifdef WITH_FUNCALL_TRACING
   timeEnter <- liftIO $ getTime ProcessCPUTime
   esTraceOutput %= (TraceFunctionEnter timeEnter sf info:)
 #endif
   v <- act
   esStack %= safeTail
+  esCheckRecursion %= getPrevRecCheck
   pv <- enforcePactValue info v
   rtcEnabled <- isExecutionFlagSet FlagDisableRuntimeRTC
   unless rtcEnabled $ maybeTCType info mty pv
@@ -664,6 +666,16 @@ evalWithStackFrame info sf mty act = do
   esTraceOutput %= (TraceFunctionExit timeExit sf info:)
 #endif
   return (VPactValue pv)
+  where
+  checkRecursion = do
+    RecursionCheck currentCalled <- uses esCheckRecursion NE.head
+    let qn = fqnToQualName (_sfName sf)
+    when (S.member qn currentCalled) $ throwExecutionError info (RuntimeRecursionDetected qn)
+    esCheckRecursion %= NE.cons (RecursionCheck (S.insert qn currentCalled))
+  getPrevRecCheck (_ :| l) = case l of
+    top : rest -> top :| rest
+    [] -> (RecursionCheck mempty) :| []
+
 {-# INLINE evalWithStackFrame #-}
 
 applyLamUnsafe

pact-tests/pact-tests/modref-recursion.repl

@@ -27,7 +27,7 @@
   )
 
 (env-gasmodel "table")
-(env-gaslimit 10) ; ensures test does not run forever in case recursion breaks
+(env-gaslimit 1000) ; ensures test does not run forever in case recursion breaks
 
 
-(expect-failure "Recursion should fail @ runtime" (knot2.callF knot1))
+(expect-failure "Recursion should fail @ runtime" "Recursion detected by the runtime. Recursing in function: knot2.callF" (knot2.callF knot1))