projects
/
ghc-base.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
ea5b917
)
Fix bugs in Text.Printf (#1548)
author
Simon Marlow
<marlowsd@gmail.com>
Tue, 16 Sep 2008 13:35:05 +0000
(13:35 +0000)
committer
Simon Marlow
<marlowsd@gmail.com>
Tue, 16 Sep 2008 13:35:05 +0000
(13:35 +0000)
Text/Printf.hs
patch
|
blob
|
history
diff --git
a/Text/Printf.hs
b/Text/Printf.hs
index
bfd1ed6
..
4b11931
100644
(file)
--- a/
Text/Printf.hs
+++ b/
Text/Printf.hs
@@
-1,7
+1,7
@@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Printf
-----------------------------------------------------------------------------
-- |
-- Module : Text.Printf
--- Copyright : (c) Lennart Augustsson, 2004
+-- Copyright : (c) Lennart Augustsson, 2004-2008
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : lennart@augustsson.net
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : lennart@augustsson.net
@@
-147,10
+147,8
@@
instance PrintfArg Int32 where
instance PrintfArg Int64 where
toUPrintf = uInteger
instance PrintfArg Int64 where
toUPrintf = uInteger
-#ifndef __NHC__
instance PrintfArg Word where
toUPrintf = uInteger
instance PrintfArg Word where
toUPrintf = uInteger
-#endif
instance PrintfArg Word8 where
toUPrintf = uInteger
instance PrintfArg Word8 where
toUPrintf = uInteger
@@
-226,7
+224,7
@@
fmt cs us =
'f' -> adjust' (dfmt' c prec u)
'g' -> adjust' (dfmt' c prec u)
'G' -> adjust' (dfmt' c prec u)
'f' -> adjust' (dfmt' c prec u)
'g' -> adjust' (dfmt' c prec u)
'G' -> adjust' (dfmt' c prec u)
- 's' -> adjust ("", tostr u)
+ 's' -> adjust ("", tostr prec u)
_ -> perror ("bad formatting char " ++ [c])
) ++ uprintf cs'' us''
_ -> perror ("bad formatting char " ++ [c])
) ++ uprintf cs'' us''
@@
-245,9
+243,9
@@
toint (UInteger _ i) = fromInteger i
toint (UChar c) = fromEnum c
toint _ = baderr
toint (UChar c) = fromEnum c
toint _ = baderr
-tostr :: UPrintf -> String
-tostr (UString s) = s
-tostr _ = baderr
+tostr :: Int -> UPrintf -> String
+tostr n (UString s) = if n >= 0 then take n s else s
+tostr _ _ = baderr
itosb :: Integer -> Integer -> String
itosb b n =
itosb :: Integer -> Integer -> String
itosb b n =
@@
-265,28
+263,37
@@
getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool
getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
-getSpecs l z s ('*':cs) us =
- case us of
- [] -> argerr
- nu : us' ->
- let n = toint nu
- (p, cs'', us'') =
+getSpecs l z s ('*':cs) us =
+ let (us', n) = getStar us
+ ((p, cs''), us'') =
case cs of
case cs of
- '.':'*':r -> case us' of { [] -> argerr; pu:us''' -> (toint pu, r, us''') }
- '.':r -> let (n', cs') = stoi 0 r in (n', cs', us')
- _ -> (-1, cs, us')
- in (n, p, l, z, s, cs'', us'')
+ '.':'*':r -> let (us''', p') = getStar us'
+ in ((p', r), us''')
+ '.':r -> (stoi 0 r, us')
+ _ -> ((-1, cs), us')
+ in (n, p, l, z, s, cs'', us'')
getSpecs l z s ('.':cs) us =
getSpecs l z s ('.':cs) us =
- let (p, cs') = stoi 0 cs
- in (0, p, l, z, s, cs', us)
+ let ((p, cs'), us') =
+ case cs of
+ '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
+ _ -> (stoi 0 cs, us)
+ in (0, p, l, z, s, cs', us')
getSpecs l z s cs@(c:_) us | isDigit c =
let (n, cs') = stoi 0 cs
getSpecs l z s cs@(c:_) us | isDigit c =
let (n, cs') = stoi 0 cs
- (p, cs'') = case cs' of
- '.':r -> stoi 0 r
- _ -> (-1, cs')
- in (n, p, l, z, s, cs'', us)
+ ((p, cs''), us') = case cs' of
+ '.':'*':r -> let (us'', p') = getStar us in ((p', r), us'')
+ '.':r -> (stoi 0 r, us)
+ _ -> ((-1, cs'), us)
+ in (n, p, l, z, s, cs'', us')
getSpecs l z s cs us = (0, -1, l, z, s, cs, us)
getSpecs l z s cs us = (0, -1, l, z, s, cs, us)
+getStar :: [UPrintf] -> ([UPrintf], Int)
+getStar us =
+ case us of
+ [] -> argerr
+ nu : us' -> (us', toint nu)
+
+
dfmt' :: Char -> Int -> UPrintf -> (String, String)
dfmt' c p (UDouble d) = dfmt c p d
dfmt' c p (UFloat f) = dfmt c p f
dfmt' :: Char -> Int -> UPrintf -> (String, String)
dfmt' c p (UDouble d) = dfmt c p d
dfmt' c p (UFloat f) = dfmt c p f