diff options
-rw-r--r-- | libraries/base/Data/Functor/Classes.hs | 10 | ||||
-rw-r--r-- | libraries/base/tests/T19719.hs | 26 | ||||
-rw-r--r-- | libraries/base/tests/T19719.stdout | 16 | ||||
-rw-r--r-- | libraries/base/tests/all.T | 1 |
4 files changed, 50 insertions, 3 deletions
diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs index 6a0d008982..d672c340d7 100644 --- a/libraries/base/Data/Functor/Classes.hs +++ b/libraries/base/Data/Functor/Classes.hs @@ -848,11 +848,13 @@ instance Eq1 Complex where -- [(2 % 3 :+ 3 % 4,"")] -- instance Read1 Complex where - liftReadPrec rp _ = parens $ prec 9 $ do + liftReadPrec rp _ = parens $ prec complexPrec $ do x <- step rp expectP (Symbol ":+") y <- step rp return (x :+ y) + where + complexPrec = 6 liftReadListPrec = liftReadListPrecDefault liftReadList = liftReadListDefault @@ -863,8 +865,10 @@ instance Read1 Complex where -- "2 :+ 3" -- instance Show1 Complex where - liftShowsPrec sp _ d (x :+ y) = showParen (d >= 10) $ - sp 10 x . showString " :+ " . sp 10 y + liftShowsPrec sp _ d (x :+ y) = showParen (d > complexPrec) $ + sp (complexPrec+1) x . showString " :+ " . sp (complexPrec+1) y + where + complexPrec = 6 -- Building blocks diff --git a/libraries/base/tests/T19719.hs b/libraries/base/tests/T19719.hs new file mode 100644 index 0000000000..613f92ad6c --- /dev/null +++ b/libraries/base/tests/T19719.hs @@ -0,0 +1,26 @@ +module Main (main) where + +import Data.Complex (Complex(..)) +import Data.Functor.Classes (readPrec1, showsPrec1) +import Text.ParserCombinators.ReadPrec (readPrec_to_S) +import Text.Read (Read(..)) + +comp :: Complex Int +comp = 1 :+ 1 + +compareInstances :: Int -> IO () +compareInstances p = do + let precBanner = " (at precedence " ++ show p ++ ")" + putStrLn $ "Read vs. Read1" ++ precBanner + print (readPrec_to_S readPrec p "1 :+ 1" :: [(Complex Int, String)]) + print (readPrec_to_S readPrec1 p "1 :+ 1" :: [(Complex Int, String)]) + putStrLn "" + putStrLn $ "Show vs. Show1" ++ precBanner + putStrLn $ showsPrec p comp "" + putStrLn $ showsPrec1 p comp "" + putStrLn "" + +main :: IO () +main = do + compareInstances 6 + compareInstances 7 diff --git a/libraries/base/tests/T19719.stdout b/libraries/base/tests/T19719.stdout new file mode 100644 index 0000000000..8f59bd40f0 --- /dev/null +++ b/libraries/base/tests/T19719.stdout @@ -0,0 +1,16 @@ +Read vs. Read1 (at precedence 6) +[(1 :+ 1,"")] +[(1 :+ 1,"")] + +Show vs. Show1 (at precedence 6) +1 :+ 1 +1 :+ 1 + +Read vs. Read1 (at precedence 7) +[] +[] + +Show vs. Show1 (at precedence 7) +(1 :+ 1) +(1 :+ 1) + diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index b02d77ef11..7ea69949e2 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -263,3 +263,4 @@ test('T16643', normal, compile_and_run, ['']) test('clamp', normal, compile_and_run, ['']) test('T18642', extra_run_opts('+RTS -T -RTS'), compile_and_run, ['-O2']) test('T19288', exit_code(1), compile_and_run, ['']) +test('T19719', normal, compile_and_run, ['']) |