-
Notifications
You must be signed in to change notification settings - Fork 463
/
Spec.hs
90 lines (75 loc) · 2.18 KB
/
Spec.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main (main) where
import Common
import PlutusPrelude
import TestLib
import OptimizerSpec
import ParserSpec
import TransformSpec
import TypeSpec
import Language.PlutusIR
import Language.PlutusIR.Parser hiding (Error)
import qualified Language.PlutusCore as PLC
import Test.Tasty
import Codec.Serialise
main :: IO ()
main = defaultMain $ runTestNestedIn ["plutus-ir-test"] tests
tests :: TestNested
tests = testGroup "plutus-ir" <$> sequence
[ prettyprinting
, parsing
, lets
, datatypes
, recursion
, serialization
, errors
, optimizer
, transform
, types
, typeErrors
]
prettyprinting :: TestNested
prettyprinting = testNested "prettyprinting"
$ map (goldenPir id term)
[ "basic"
, "maybe"
]
lets :: TestNested
lets = testNested "lets"
[ goldenPlcFromPir term "letInLet"
, goldenPlcFromPir term "letDep"
]
datatypes :: TestNested
datatypes = testNested "datatypes"
[ goldenPlcFromPir term "maybe"
, goldenPlcFromPir term "listMatch"
, goldenEvalPir term "listMatchEval"
]
recursion :: TestNested
recursion = testNested "recursion"
[ goldenPlcFromPir term "even3"
, goldenEvalPir term "even3Eval"
, goldenPlcFromPir term "stupidZero"
, goldenPlcFromPir term "mutuallyRecursiveValues"
]
serialization :: TestNested
serialization = testNested "serialization"
$ map (goldenPir roundTripPirTerm term)
[ "serializeBasic"
, "serializeMaybePirTerm"
, "serializeEvenOdd"
, "serializeListMatch"
]
roundTripPirTerm :: Term TyName Name PLC.DefaultUni a -> Term TyName Name PLC.DefaultUni ()
roundTripPirTerm = deserialise . serialise . void
errors :: TestNested
errors = testNested "errors"
[ goldenPlcFromPirCatch term "mutuallyRecursiveTypes"
, goldenPlcFromPirCatch term "recursiveTypeBind"
]