|
| 1 | +{-# LANGUAGE DerivingStrategies #-} |
| 2 | +{-# LANGUAGE OverloadedStrings #-} |
| 3 | +{-# LANGUAGE TemplateHaskell #-} |
| 4 | +{-# LANGUAGE TypeApplications #-} |
| 5 | + |
| 6 | +module Enum.Spec (enumTests) where |
| 7 | + |
| 8 | +import PlutusTx.Eq qualified as Tx |
| 9 | +import PlutusTx.Enum as Tx |
| 10 | +import PlutusTx.Test.Golden |
| 11 | +import Test.Tasty.Extras |
| 12 | +import Hedgehog |
| 13 | +import Hedgehog.Gen |
| 14 | +import Test.Tasty.Hedgehog |
| 15 | +import Test.Tasty |
| 16 | +import Test.Tasty.HUnit |
| 17 | +import Prelude hiding (Eq (..), error) |
| 18 | +import Prelude qualified as HS (Eq (..), Enum (..), Bounded (..), Show (..)) |
| 19 | +import Control.Monad as HS (unless) |
| 20 | +import PlutusTx.List qualified as Tx |
| 21 | +import Data.List qualified as HS (intercalate, nub) |
| 22 | + |
| 23 | +data SomeVeryLargeEnum |
| 24 | + = E1 |
| 25 | + | E2 |
| 26 | + | E3 |
| 27 | + | E4 |
| 28 | + | E5 |
| 29 | + | E6 |
| 30 | + | E7 |
| 31 | + | E8 |
| 32 | + | E9 |
| 33 | + | E10 |
| 34 | + deriving stock (HS.Eq, HS.Enum, HS.Bounded, HS.Show) |
| 35 | +deriveEnum ''SomeVeryLargeEnum |
| 36 | + |
| 37 | +-- we lack Tx.Bounded so we use Haskell's for the tests |
| 38 | +enumTests :: TestTree |
| 39 | +enumTests = |
| 40 | + let |
| 41 | + in testGroup |
| 42 | + "PlutusTx.Enum tests" |
| 43 | + [ testProperty "no dups" prop_nodups |
| 44 | + , testCase "full length" $ Tx.length (Tx.enumFromTo @SomeVeryLargeEnum HS.minBound HS.maxBound) @?= Tx.fromEnum @SomeVeryLargeEnum HS.maxBound + 1 |
| 45 | + , runTestNested |
| 46 | + ["test", "Enum", "Golden"] |
| 47 | + [ $(goldenCodeGen "SomeVeryLargeEnum" (deriveEnum ''SomeVeryLargeEnum)) |
| 48 | + , $(goldenCodeGen "Bool" (deriveEnum ''Bool)) |
| 49 | + , $(goldenCodeGen "Unit" (deriveEnum ''())) |
| 50 | + ] |
| 51 | + , enumFromToTests |
| 52 | + , enumFromThenToTests |
| 53 | + ] |
| 54 | + |
| 55 | +-- we lack Tx.Bounded so we use Haskell's for the tests |
| 56 | +prop_nodups :: Property |
| 57 | +prop_nodups = property $ do |
| 58 | + from <- forAll enumBounded |
| 59 | + to <- forAll enumBounded |
| 60 | + let res = Tx.enumFromTo @SomeVeryLargeEnum from to |
| 61 | + HS.nub res === res |
| 62 | + |
| 63 | +enumFromToTests :: TestTree |
| 64 | +enumFromToTests = |
| 65 | + testGroup |
| 66 | + "enumFromTo" |
| 67 | + [ testCase "enumFromTo (-2) 2 == [-2..2]" $ Tx.enumFromTo @Integer (-2) 2 @?= [-2 .. 2] |
| 68 | + , testCase "enumFromTo 2 (-2) == []" $ Tx.enumFromTo @Integer 2 (-2) @?= [] |
| 69 | + , testCase "enumFromTo 42 42 == [42]" $ Tx.enumFromTo @Integer 42 42 @?= [42] |
| 70 | + ] |
| 71 | + |
| 72 | +enumFromThenToTests :: TestTree |
| 73 | +enumFromThenToTests = |
| 74 | + testGroup |
| 75 | + "enumFromThenTo" |
| 76 | + [ testCase "enumFromThenTo 1 2 100 == [1..100]" $ |
| 77 | + Tx.enumFromThenTo @Integer 1 2 100 @?=* [1 .. 100] |
| 78 | + , testCase "enumFromThenTo 1 2 100 == [1,2..100]" $ |
| 79 | + Tx.enumFromThenTo @Integer 1 2 100 @?=* [1, 2 .. 100] |
| 80 | + , testCase "enumFromThenTo 100 99 1 == [100,99..1]" $ |
| 81 | + Tx.enumFromThenTo @Integer 100 99 1 @?=* [100, 99 .. 1] |
| 82 | + , testCase "enumFromThenTo 100 17 (-700) == [100,17..(-700)]" $ |
| 83 | + Tx.enumFromThenTo @Integer 100 17 (-700) @?=* [100, 17 .. (-700)] |
| 84 | + , testCase "enumFromThenTo 0 5 99 == [0,5..99]" $ |
| 85 | + Tx.enumFromThenTo @Integer 0 5 99 @?=* [0, 5 .. 99] |
| 86 | + , testCase "enumFromThenTo 0 5 100 == [0,5..100]" $ |
| 87 | + Tx.enumFromThenTo @Integer 0 5 100 @?=* [0, 5 .. 100] |
| 88 | + , testCase "enumFromThenTo 0 5 101 == [0,5..101]" $ |
| 89 | + Tx.enumFromThenTo @Integer 0 5 101 @?=* [0, 5 .. 101] |
| 90 | + , testCase "enumFromThenTo 100 95 0 == [100,95..0]" $ |
| 91 | + Tx.enumFromThenTo @Integer 100 95 0 @?=* [100, 95 .. 0] |
| 92 | + , testCase "enumFromThenTo 100 95 (-9) == [100,95..(-9)]" $ |
| 93 | + Tx.enumFromThenTo @Integer 100 95 (-9) @?=* [100, 95 .. (-9)] |
| 94 | + , testCase "enumFromThenTo 100 95 (-10) == [100,95..(-10)]" $ |
| 95 | + Tx.enumFromThenTo @Integer 100 95 (-10) @?=* [100, 95 .. (-10)] |
| 96 | + , testCase "enumFromThenTo 100 95 (-11) == [100,95..(-11)]" $ |
| 97 | + Tx.enumFromThenTo @Integer 100 95 (-11) @?=* [100, 95 .. (-11)] |
| 98 | + , testCase "enumFromThenTo 42 42 41 == []" $ |
| 99 | + Tx.enumFromThenTo @Integer 42 42 41 @?=* [] |
| 100 | + , testCase "enumFromThenTo 42 42 42 == [42*]" $ |
| 101 | + Tx.enumFromThenTo @Integer 42 42 42 @?=* [42, 42 .. 42] |
| 102 | + , testCase "enumFromThenTo 42 42 43 == [42*]" $ |
| 103 | + Tx.enumFromThenTo @Integer 42 42 43 @?=* [42, 42 .. 43] |
| 104 | + , testCase "enumFromThenTo False False False == [False*]" $ |
| 105 | + Tx.enumFromThenTo False False False @?=* [False, False .. False] |
| 106 | + , testCase "enumFromThenTo False False True == [False*]" $ |
| 107 | + Tx.enumFromThenTo False False True @?=* [False, False .. True] |
| 108 | + , testCase "enumFromThenTo False True False == [False]" $ |
| 109 | + Tx.enumFromThenTo False True False @?=* [False, True .. False] |
| 110 | + , testCase "enumFromThenTo False True True == [False,True]" $ |
| 111 | + Tx.enumFromThenTo False True True @?=* [False, True .. True] |
| 112 | + , testCase "enumFromThenTo True False False == [True,False]" $ |
| 113 | + Tx.enumFromThenTo True False False @?=* [True, False .. False] |
| 114 | + , testCase "enumFromThenTo True False True == [True]" $ |
| 115 | + Tx.enumFromThenTo True False True @?=* [True, False .. True] |
| 116 | + , testCase "enumFromThenTo True True False == []" $ |
| 117 | + Tx.enumFromThenTo True True False @?=* [True, True .. False] |
| 118 | + , testCase "enumFromThenTo True True True == [True*]" $ |
| 119 | + Tx.enumFromThenTo True True True @?=* [True, True .. True] |
| 120 | + , testCase "enumFromThenTo () () () == [()*]" $ |
| 121 | + Tx.enumFromThenTo () () () @?=* [(), () .. ()] |
| 122 | + ] |
| 123 | + where |
| 124 | + {- Check (approximately) that two possibly infinite lists are equal. We can get infinite lists from |
| 125 | + `enumFromThenTo`, both legitimately and because of implementation errors (which are exactly |
| 126 | + what we're testing for here). If we just use @?= then (a) it won't terminate if we give it |
| 127 | + two equal infinite lists, and (b) if it fails and one of the lists is infinite then it'll try |
| 128 | + to generate an infinite error message, again leading to non-termination. To deal with this, |
| 129 | + if an argument has more than 1000 elements then we assume it's infinite and just include an |
| 130 | + initial segment in any error message, and when we're comparing two such "infinite" lists we |
| 131 | + just compare the first 1000 elements. The only infinite lists that enumFromThenTo can |
| 132 | + generate are of the form [x,x,x,...], so this is definitely a safe strategy in this context. |
| 133 | + -} |
| 134 | + l1 @?=* l2 = |
| 135 | + case (possiblyInfinite l1, possiblyInfinite l2) of |
| 136 | + (False, False) -> l1 @?= l2 |
| 137 | + (True, False) -> failWith (showInit l1) (show l2) |
| 138 | + (False, True) -> failWith (show l1) (showInit l2) |
| 139 | + (True, True) -> HS.unless (take 1000 l1 Tx.== take 1000 l2) (failWith (showInit l1) (showInit l2)) |
| 140 | + where |
| 141 | + possiblyInfinite l = Tx.drop 1000 l Tx./= [] |
| 142 | + showInit l = "[" ++ HS.intercalate "," (fmap show (take 5 l)) ++ ",...]" |
| 143 | + failWith expected actual = assertFailure ("expected: " ++ expected ++ "\n but got: " ++ actual) |
0 commit comments