[FORK] Add runtime type check for function return types

examples/cp/orders.pact

@@ -48,7 +48,7 @@
 
   )
 
-  (defun with-order-status:object{order} (order-id status)
+  (defun with-order-status (order-id status)
     "Check that order status is correct, returning details"
     (let ((o (read orders order-id)))
       (enforce (= (at 'status o) status)

src/Pact/Eval.hs

@@ -1172,7 +1172,14 @@ functionApp fnName funTy mod_ as fnBody docs ai = do
   let body = instantiate (resolveArg ai args') fnBody
       fname = asString fnName
       fa = FunApp ai fname mod_ Defun (funTypes fty) docs
-  guardRecursion fname mod_ $ appCall fa ai args' $ fmap (gas,) $ reduceBody body
+
+  returnVal <- guardRecursion fname mod_ $ appCall fa ai args' $ fmap (gas,) $ reduceBody body
+
+  unlessExecutionFlagSet FlagDisablePact47 $
+    typecheckTerm ai (_ftReturn fty) returnVal
+
+  return returnVal
+
 
 -- | Evaluate a dynamic ref to either a fully-reduced value from a 'TConst'
 -- or a module member 'Def' for applying.

tests/pact/tc.repl

@@ -368,3 +368,27 @@
  "rtc object lists"
  1
  (rtc-object-list (let ((a {'a:1}) (b {'a: 2})) [a b])))
+
+;; A module with incorrect annotations for a function's return type.
+;; Runtime typechecking for function return types was added in
+;; pact-4.7.
+(module tc-test-function-return-types g
+  (defcap g () true)
+  (defun f:string () (+ 1 2))
+)
+
+(expect-failure
+  "evaluating a function whose type signature conflits with its body should fail"
+  (tc-test-function-return-types.f)
+  )
+
+(expect-failure
+  "composing an ill-typed function with another function should not evaluate"
+  (tc-test-function-return-types.g (tc-test-function-return-types.f 1))
+  )
+
+(env-exec-config ["DisablePact47"])
+(expect
+  "evaluatingn ill-typed function should succeed with pact-4.7 features disabled"
+  3
+  (tc-test-function-return-types.f))