1
1
module Functora.RoundSpec (spec ) where
2
2
3
+ import Data.Fixed (E12 , Fixed )
3
4
import Functora.Prelude (throw , throwString , try )
4
5
import Functora.Round (dpRound , sdRound )
6
+ import Numeric.Natural (Natural )
5
7
import System.Exit (ExitCode (.. ))
6
8
import Test.DocTest (doctest )
7
- import Test.Hspec ( Spec , it )
9
+ import Test.Hspec
8
10
import Test.Tasty (TestTree , defaultMain , testGroup )
9
11
import Test.Tasty.HUnit as HU (testCase , (@?=) )
10
- import Test.Tasty.QuickCheck as QC
12
+ import qualified Test.Tasty.QuickCheck as QC
11
13
import Prelude
12
14
13
15
spec :: Spec
@@ -24,6 +26,14 @@ spec = do
24
26
" src/round/Functora/Round.hs"
25
27
]
26
28
29
+ mkRoundSpec @ (Fixed E12 ) " dpRound/Fixed" dpRound dpRoundTestData
30
+ mkRoundSpec @ Rational " dpRound/Rational" dpRound dpRoundTestData
31
+ mkRoundSpec @ Double " dpRound/Double" dpRound dpRoundTestData
32
+
33
+ mkRoundSpec @ (Fixed E12 ) " sdRound/Fixed" sdRound sdRoundTestData
34
+ mkRoundSpec @ Rational " sdRound/Rational" sdRound sdRoundTestData
35
+ mkRoundSpec @ Double " sdRound/Double" sdRound sdRoundTestData
36
+
27
37
--
28
38
-- Tasty
29
39
--
@@ -104,3 +114,70 @@ qcProps =
104
114
dpIdempotent :: Integer -> Rational -> Bool
105
115
dpIdempotent dp x =
106
116
let y = dpRound dp x in dpRound dp y == y
117
+
118
+ mkRoundSpec ::
119
+ (Show a , RealFrac a ) => String -> (b -> a -> a ) -> [(b , a , a )] -> Spec
120
+ mkRoundSpec label f =
121
+ it label . mapM_ (\ (x, prev, next) -> f x prev `shouldBe` next)
122
+
123
+ -- | Every element is a tuple (decimalPlaces, beforeRound, afterRound)
124
+ dpRoundTestData :: (RealFrac a ) => [(Integer , a , a )]
125
+ dpRoundTestData =
126
+ [ (2 , 123456789.0 , 123456789.0 ),
127
+ (2 , 1234.56789 , 1234.57 ),
128
+ (2 , 123.456789 , 123.46 ),
129
+ (2 , 12.3456789 , 12.35 ),
130
+ (2 , 1.23456789 , 1.23 ),
131
+ (2 , 0.123456789 , 0.12 ),
132
+ (2 , 0.0123456789 , 0.01 ),
133
+ (2 , 0.00123456789 , 0.00 ),
134
+ (3 , 123456789.0 , 123456789.0 ),
135
+ (3 , 1234.56789 , 1234.568 ),
136
+ (3 , 123.456789 , 123.457 ),
137
+ (3 , 12.3456789 , 12.346 ),
138
+ (3 , 1.23456789 , 1.235 ),
139
+ (3 , 0.123456789 , 0.123 ),
140
+ (3 , 0.0123456789 , 0.012 ),
141
+ (3 , 0.00123456789 , 0.001 ),
142
+ (3 , 0.000123456789 , 0.000 ),
143
+ (4 , 123456789.0 , 123456789.0 ),
144
+ (4 , 1234.56789 , 1234.5679 ),
145
+ (4 , 123.456789 , 123.4568 ),
146
+ (4 , 12.3456789 , 12.3457 ),
147
+ (4 , 1.23456789 , 1.2346 ),
148
+ (4 , 0.123456789 , 0.1235 ),
149
+ (4 , 0.0123456789 , 0.0123 ),
150
+ (4 , 0.00123456789 , 0.0012 ),
151
+ (4 , 0.000123456789 , 0.0001 ),
152
+ (4 , 0.0000123456789 , 0.0000 )
153
+ ]
154
+
155
+ -- | Every element is a tuple (significantDigits, beforeRound, afterRound)
156
+ sdRoundTestData :: (RealFrac a ) => [(Natural , a , a )]
157
+ sdRoundTestData =
158
+ [ (4 , 123456789.0 , 123500000.0 ),
159
+ (4 , 1234.56789 , 1235.0 ),
160
+ (4 , 123.456789 , 123.5 ),
161
+ (4 , 12.3456789 , 12.35 ),
162
+ (4 , 1.23456789 , 1.235 ),
163
+ (4 , 0.123456789 , 0.1235 ),
164
+ (4 , 0.0123456789 , 0.01235 ),
165
+ (4 , 0.00123456789 , 0.001235 ),
166
+ (4 , 0.000123456789 , 0.0001235 ),
167
+ (5 , 123456789.0 , 123460000.0 ),
168
+ (5 , 1234.56789 , 1234.6 ),
169
+ (5 , 123.456789 , 123.46 ),
170
+ (5 , 12.3456789 , 12.346 ),
171
+ (5 , 1.23456789 , 1.2346 ),
172
+ (5 , 0.123456789 , 0.12346 ),
173
+ (5 , 0.0123456789 , 0.012346 ),
174
+ (5 , 0.00123456789 , 0.0012346 ),
175
+ (5 , 0.000123456789 , 0.00012346 ),
176
+ (6 , 123456789.0 , 123457000.0 ),
177
+ (6 , 1234.56789 , 1234.57 ),
178
+ (6 , 123.456789 , 123.457 ),
179
+ (6 , 12.3456789 , 12.3457 ),
180
+ (6 , 1.23456789 , 1.23457 ),
181
+ (6 , 0.123456789 , 0.123457 ),
182
+ (6 , 0.0123456789 , 0.0123457 )
183
+ ]
0 commit comments