Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
text
Commits
789c63f6
Commit
789c63f6
authored
Dec 12, 2014
by
bos
Browse files
Add a (failing) QuickCheck test for formatRealFloat (gh-105)
parent
57e628e2
Changes
2
Hide whitespace changes
Inline
Side-by-side
tests/Tests/Properties.hs
View file @
789c63f6
...
...
@@ -24,7 +24,7 @@ import Data.Text.Internal.Search (indices)
import
Data.Text.Lazy.Read
as
TL
import
Data.Text.Read
as
T
import
Data.Word
(
Word
,
Word8
,
Word16
,
Word32
,
Word64
)
import
Numeric
(
showHex
)
import
Numeric
(
showGFloat
,
showHex
)
import
Prelude
hiding
(
replicate
)
import
Test.Framework
(
Test
,
testGroup
)
import
Test.Framework.Providers.QuickCheck2
(
testProperty
)
...
...
@@ -779,6 +779,15 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
tb_realfloat_float
(
a
::
Float
)
=
tb_realfloat
a
tb_realfloat_double
(
a
::
Double
)
=
tb_realfloat
a
tb_formatRealFloat_G
::
(
RealFloat
a
,
Show
a
)
=>
a
->
Precision
a
->
Property
tb_formatRealFloat_G
a
prec
=
TB
.
formatRealFloat
TB
.
Generic
p
a
===
TB
.
fromString
(
showGFloat
p
a
""
)
where
p
=
precision
a
prec
tb_formatRealFloat_G_float
(
a
::
Float
)
=
tb_formatRealFloat_G
a
tb_formatRealFloat_G_double
(
a
::
Double
)
=
tb_formatRealFloat_G
a
-- Reading.
t_decimal
(
n
::
Int
)
s
=
...
...
@@ -1284,7 +1293,9 @@ tests =
],
testGroup
"realfloat"
[
testProperty
"tb_realfloat_double"
tb_realfloat_double
,
testProperty
"tb_realfloat_float"
tb_realfloat_float
testProperty
"tb_realfloat_float"
tb_realfloat_float
,
testProperty
"tb_formatRealFloat_G_float"
tb_formatRealFloat_G_float
,
testProperty
"tb_formatRealFloat_G_double"
tb_formatRealFloat_G_double
],
testProperty
"tb_fromText"
tb_fromText
,
testProperty
"tb_singleton"
tb_singleton
...
...
tests/Tests/QuickCheckUtils.hs
View file @
789c63f6
...
...
@@ -17,6 +17,9 @@ module Tests.QuickCheckUtils
,
Small
(
..
)
,
small
,
Precision
(
..
)
,
precision
,
integralRandomR
,
DecodeErr
(
..
)
...
...
@@ -263,6 +266,27 @@ eqP f g s w = eql "orig" (f s) (g t) &&
|
a
=^=
b
=
True
|
otherwise
=
trace
(
d
++
": "
++
show
a
++
" /= "
++
show
b
)
False
newtype
Precision
a
=
Precision
(
Maybe
Int
)
deriving
(
Eq
,
Show
)
precision
::
a
->
Precision
a
->
Maybe
Int
precision
_
(
Precision
prec
)
=
prec
arbitraryPrecision
::
Int
->
Gen
(
Precision
a
)
arbitraryPrecision
maxDigits
=
Precision
<$>
do
n
<-
choose
(
-
1
,
maxDigits
)
return
$
if
n
==
-
1
then
Nothing
else
Just
n
instance
Arbitrary
(
Precision
Float
)
where
arbitrary
=
arbitraryPrecision
11
shrink
=
map
Precision
.
shrink
.
precision
undefined
instance
Arbitrary
(
Precision
Double
)
where
arbitrary
=
arbitraryPrecision
22
shrink
=
map
Precision
.
shrink
.
precision
undefined
-- Work around lack of Show instance for TextEncoding.
data
Encoding
=
E
String
IO
.
TextEncoding
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment