#7483: Broken Read instance for Data.Fixed (no parse in legitimate cases).
-+--
Reporter: navaati | Owner:
Type: bug | Status: new
Priority: normal| Milestone:
Component: libraries/base| Version: 7.6.1
Keywords:| Os: Unknown/Multiple
Architecture: Unknown/Multiple | Failure: Incorrect result at runtime
Difficulty: Unknown |Testcase:
Blockedby:|Blocking:
Related: #4502 |
-+--
Changes (by simonpj):
* difficulty: = Unknown
Comment:
This commit claims to fix it. Close?
{{{
commit 3fb1aacabbded36e9203adf922af197db0652646
Author: Ian Lynagh i...@well-typed.com
Date: Wed Jan 2 23:18:18 2013 +
Fix Data.Fixed.Fixed's Read instance; fixes #7483
---
Data/Fixed.hs | 37 ++---
GHC/Read.lhs |1 +
Text/Read/Lex.hs | 18 +-
tests/all.T |1 +
tests/readFixed001.hs | 13 +
tests/readFixed001.stdout |6 ++
6 files changed, 52 insertions(+), 24 deletions(-)
diff --git a/Data/Fixed.hs b/Data/Fixed.hs index b4a9857..fd0ca01 100644
--- a/Data/Fixed.hs
+++ b/Data/Fixed.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, PatternGuards #-}
{-# OPTIONS -Wall -fno-warn-unused-binds #-} #ifndef __NHC__ {-#
LANGUAGE DeriveDataTypeable #-} @@ -40,12 +40,13 @@ module Data.Fixed
) where
import Prelude -- necessary to get dependencies right -import Data.Char
-import Data.List #ifndef __NHC__ import Data.Typeable import Data.Data
#endif
+import GHC.Read
+import Text.ParserCombinators.ReadPrec
+import Text.Read.Lex
#ifndef __NHC__
default () -- avoid any defaulting shenanigans @@ -159,30 +160,20 @@
showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot
(showIntegerZe
maxnum = 10 ^ digits
fracNum = div (d * maxnum) res
-readsFixed :: (HasResolution a) = ReadS (Fixed a) -readsFixed =
readsSigned
-where readsSigned ('-' : xs) = [ (negate x, rest)
- | (x, rest) - readsUnsigned xs ]
- readsSigned xs = readsUnsigned xs
- readsUnsigned xs = case span isDigit xs of
- ([], _) - []
- (is, xs') -
- let i = fromInteger (read is)
- in case xs' of
-'.' : xs'' -
-case span isDigit xs'' of
-([], _) - []
-(js, xs''') -
-let j = fromInteger (read js)
-l = genericLength js ::
Integer
-in [(i + (j / (10 ^ l)),
xs''')]
-_ - [(i, xs')]
-
instance (HasResolution a) = Show (Fixed a) where
show = showFixed False
instance (HasResolution a) = Read (Fixed a) where
-readsPrec _ = readsFixed
+readPrec = readNumber convertFixed
+readListPrec = readListPrecDefault
+readList = readListDefault
+
+convertFixed :: forall a . HasResolution a = Lexeme - ReadPrec (Fixed
+a) convertFixed (Number n)
+ | Just (i, f) - numberToFixed r n =
+return (fromInteger i + (fromInteger f / (10 ^ r)))
+where r = resolution (undefined :: Fixed a) convertFixed _ = pfail
data E0 = E0
#ifndef __NHC__
diff --git a/GHC/Read.lhs b/GHC/Read.lhs index c542274..5ad9527 100644
--- a/GHC/Read.lhs
+++ b/GHC/Read.lhs
@@ -38,6 +38,7 @@ module GHC.Read
, list
, choose
, readListDefault, readListPrecDefault
+ , readNumber
-- Temporary
, readParen
diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index 8a64e21..c1592c6
100644
--- a/Text/Read/Lex.hs
+++ b/Text/Read/Lex.hs
@@ -19,7 +19,7 @@ module Text.Read.Lex
-- lexing types
( Lexeme(..)
- , numberToInteger, numberToRational, numberToRangedRational
+ , numberToInteger, numberToFixed, numberToRational,
+ numberToRangedRational
-- lexer
, lex, expect
@@ -82,6 +82,22 @@ numberToInteger (MkNumber base iPart) = Just (val
(fromIntegral base) 0 iPart) numberToInteger (MkDecimal iPart Nothing
Nothing) = Just (val 10 0 iPart) numberToInteger _ = Nothing
+numberToFixed :: Integer - Number - Maybe (Integer,
