Broken Read instance for Data.Fixed ("no parse" in legitimate cases).
read "Just 12.30" :: Maybe Centi throws "*** Exception: Prelude.read: no parse", as do read " 12.30" :: Centi.
Trac metadata
| Trac field | Value |
|---|---|
| Version | 7.6.1 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | libraries/base |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | leo.gillot@navaati.net |
| Operating system | |
| Architecture |
Activity
added Tbug Trac import core libraries labels
mentioned in commit 5f19f951
This commit claims to fix it. Close?
commit 3fb1aacabbded36e9203adf922af197db0652646 Author: Ian Lynagh <ian@well-typed.com> Date: Wed Jan 2 23:18:18 2013 +0000 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, Integer) +numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) 0 +iPart, 0) numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val +10 0 iPart, 0) numberToFixed p (MkDecimal iPart (Just fPart) Nothing) + = let i = val 10 0 iPart + f = val 10 0 (integerTake p (fPart ++ repeat 0)) + -- Sigh, we really want genericTake, but that's above us in + -- the hierarchy, so we define our own version here (actually + -- specialised to Integer) + integerTake :: Integer -> [a] -> [a] + integerTake n _ | n <= 0 = [] + integerTake _ [] = [] + integerTake n (x:xs) = x : integerTake (n-1) xs + in Just (i, f) +numberToFixed _ _ = Nothing + -- This takes a floatRange, and if the Rational would be outside of -- the floatRange then it may return Nothing. Not that it will not -- /necessarily/ return Nothing, but it is good enough to fix the diff --git a/tests/all.T b/tests/all.T index 8e11cf2..59354fe 100644 --- a/tests/all.T +++ b/tests/all.T @@ -20,6 +20,7 @@ test('data-fixed-show-read', normal, compile_and_run, ['']) test('showDouble', normal, compile_and_run, ['']) test('readDouble001', normal, compile_and_run, ['']) test('readInteger001', normal, compile_and_run, ['']) +test('readFixed001', normal, compile_and_run, ['']) test('lex001', normal, compile_and_run, ['']) test('take001', extra_run_opts('1'), compile_and_run, ['']) test('genericNegative001', extra_run_opts('-1'), compile_and_run, ['']) diff --git a/tests/readFixed001.hs b/tests/readFixed001.hs new file mode 100644 index 0000000..5336f9b --- /dev/null +++ b/tests/readFixed001.hs @@ -0,0 +1,13 @@ + +import Data.Fixed + +main :: IO () +main = do f " (( ( 12.3456 ) ) ) " + f " (( ( 12.3 ) ) ) " + f " (( ( 12. ) ) ) " + f " (( ( 12 ) ) ) " + f " (( - ( 12.3456 ) ) ) " + f " (( ( -12.3456 ) ) ) " + +f :: String -> IO () +f str = print (reads str :: [(Centi, String)]) diff --git a/tests/readFixed001.stdout b/tests/readFixed001.stdout new file mode 100644 index 0000000..82b2030 --- /dev/null +++ b/tests/readFixed001.stdout @@ -0,0 +1,6 @@ +[(12.34," ")] +[(12.30," ")] +[] +[(12.00," ")] +[] +[(-12.34," ")]mentioned in issue #9231 (closed)
mentioned in commit c1035d51
added incorrect runtime result label
added Pnormal label
Please register or sign in to reply