[Test] [Builtin] Polish 'MakeRead' tests (#6202)

plutus-core/untyped-plutus-core/test/Evaluation/Builtins/MakeRead.hs

@@ -20,38 +20,29 @@ import UntypedPlutusCore as UPLC (Name, Term, TyName)
 
 import Evaluation.Builtins.Common
 
+import Data.String (fromString)
 import Hedgehog hiding (Size, Var)
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 import Test.Tasty
 import Test.Tasty.Hedgehog
-import Test.Tasty.HUnit
 
 import Data.Text (Text)
 
--- | Convert a Haskell value to a PLC term and then convert back to a Haskell value
--- of a different type.
-readMakeHetero
- :: ( MakeKnown (TPLC.Term TyName Name DefaultUni DefaultFun ()) a
- , ReadKnown (UPLC.Term Name DefaultUni DefaultFun ()) b
- )
- => a -> EvaluationResult b
-readMakeHetero x = do
- xTerm <- makeKnownOrFail @_ @(TPLC.Term TyName Name DefaultUni DefaultFun ()) x
- case extractEvaluationResult <$> typecheckReadKnownCek def
- TPLC.defaultBuiltinCostModelForTesting xTerm of
- Left err -> error $ "Type error" ++ displayPlcCondensedErrorClassic err
- Right (Left err) -> error $ "Evaluation error: " ++ show err
- Right (Right res) -> res
-
--- | Convert a Haskell value to a PLC term and then convert back to a Haskell value
--- of the same type.
-readMake
+-- | Lift a Haskell value into a PLC term, evaluate it and unlift the result back to the original
+-- Haskell value.
+makeRead
  :: ( MakeKnown (TPLC.Term TyName Name DefaultUni DefaultFun ()) a
  , ReadKnown (UPLC.Term Name DefaultUni DefaultFun ()) a
  )
  => a -> EvaluationResult a
-readMake = readMakeHetero
+makeRead x = do
+ xTerm <- makeKnownOrFail @_ @(TPLC.Term TyName Name DefaultUni DefaultFun ()) x
+ case extractEvaluationResult <$> typecheckReadKnownCek def
+ TPLC.defaultBuiltinCostModelForTesting xTerm of
+ Left err -> error $ "Type error" ++ displayPlcCondensedErrorClassic err
+ Right (Left err) -> error $ "Evaluation error: " ++ show err
+ Right (Right res) -> res
 
 builtinRoundtrip
  :: ( MakeKnown (TPLC.Term TyName Name DefaultUni DefaultFun ()) a
@@ -61,7 +52,7 @@ builtinRoundtrip
  => Gen a -> Property
 builtinRoundtrip genX = property $ do
  x <- forAll genX
- case readMake x of
+ case makeRead x of
  EvaluationFailure -> fail "EvaluationFailure"
  EvaluationSuccess x' -> x === x'
 
@@ -70,42 +61,29 @@ test_textRoundtrip =
  testPropertyNamed "textRoundtrip" "textRoundtrip" . builtinRoundtrip $
  Gen.text (Range.linear 0 20) Gen.unicode
 
--- | Generate a bunch of 'text's, put each of them into a 'Term', apply a builtin over
--- each of these terms such that being evaluated it calls a Haskell function that appends a char to
--- the contents of an external 'IORef' and assemble all the resulting terms together in a single
--- term where all characters are passed to lambdas and ignored, so that only 'unitval' is returned
--- in the end.
--- After evaluation of the CEK machine finishes, read the 'IORef' and check that you got the exact
--- same sequence of 'text's that was originally generated.
--- Calls 'unsafePerformIO' internally while evaluating the term, because the CEK machine can only
--- handle pure things and 'unsafePerformIO' is the way to pretend an effectful thing is pure.
-test_collectText :: TestTree
-test_collectText = testPropertyNamed "collectText" "collectText" . property $ do
+-- | Generate a bunch of 'text's, put each of them into a 'Term' and apply the @Trace@ builtin over
+-- each of these terms and assemble all the resulting terms together in a single term where all
+-- characters are passed to lambdas and ignored, so that only 'unitval' is returned in the end.
+--
+-- After evaluation of the CEK machine finishes, check that the logs contains the exact same
+-- sequence of 'text's that was originally generated.
+test_collectText :: BuiltinSemanticsVariant DefaultFun -> TestTree
+test_collectText semVar = testPropertyNamed (show semVar) (fromString $ show semVar) . property $ do
  strs <- forAll . Gen.list (Range.linear 0 10) $ Gen.text (Range.linear 0 20) Gen.unicode
  let step arg rest = mkIterAppNoAnn (tyInst () (builtin () Trace) unit)
  [ mkConstant @Text @DefaultUni () arg
  , rest
  ]
  term = foldr step unitval (reverse strs)
- -- FIXME: semantic variant?
- strs' <- case typecheckEvaluateCek def TPLC.defaultBuiltinCostModelForTesting term of
+ strs' <- case typecheckEvaluateCek semVar TPLC.defaultBuiltinCostModelForTesting term of
  Left _ -> failure
  Right (EvaluationFailure, _) -> failure
  Right (EvaluationSuccess _, strs') -> return strs'
  strs === strs'
 
-test_noticeEvaluationFailure :: TestTree
-test_noticeEvaluationFailure =
- testCase "noticeEvaluationFailure" . assertBool "'EvaluationFailure' ignored" $
- isEvaluationFailure $ do
- _ <- readMake True
- _ <- readMakeHetero @(EvaluationResult ()) @() EvaluationFailure
- readMake ("a"::Text)
-
 test_makeRead :: TestTree
 test_makeRead =
  testGroup "makeRead"
  [ test_textRoundtrip
- , test_collectText
- , test_noticeEvaluationFailure
+ , testGroup "collectText" $ map test_collectText enumerate
  ]