[commit: testsuite] master: Test Trac #5498 (1285af7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/testsuite

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1285af76c32c84332835d5d430146403bf610796/testsuite

>---------------------------------------------------------------

commit 1285af76c32c84332835d5d430146403bf610796
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Jan 7 12:21:28 2014 +0000

    Test Trac #5498


>---------------------------------------------------------------

1285af76c32c84332835d5d430146403bf610796
 tests/deriving/should_fail/T5498.hs                |   41 ++++++++++++++++++++
 .../should_fail/T5498.stderr}                      |    0
 tests/deriving/should_fail/all.T                   |    1 +
 3 files changed, 42 insertions(+)

diff --git a/tests/deriving/should_fail/T5498.hs b/tests/deriving/should_fail/T5498.hs
new file mode 100644
index 0000000..f267e14
--- /dev/null
+++ b/tests/deriving/should_fail/T5498.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+-- | We use newtype to create an isomorphic type to Int
+-- with a reversed Ord dictionary. We now use the MinList
+-- API of MinList to create a new MinList. Then we use newtype
+-- deriving to convert the newtype MinList to an Int
+-- MinList. This final result breaks the invariants of
+-- MinList which shouldn't be possible with the exposed
+-- API of MinList.
+module T5498 where
+
+data MinList a = MinList a [a]
+
+newMinList :: Ord a => a -> MinList a
+newMinList n = MinList n []
+
+insertMinList :: Ord a => MinList a -> a -> MinList a
+insertMinList s@(MinList m xs) n | n > m     = MinList m (n:xs)
+                                 | otherwise = s
+
+printIntMinList :: MinList Int -> IO ()
+printIntMinList (MinList min xs)
+  = putStrLn $ "MinList Int :: MinList " ++ show min ++ " " ++ show xs
+
+class IntIso t where
+    intIso :: c t -> c Int
+
+instance IntIso Int where
+    intIso = id
+
+newtype Down a = Down a deriving (Eq, IntIso)
+
+instance Ord a => Ord (Down a) where
+    compare (Down a) (Down b) = compare b a
+
+fine :: MinList (Down Int)
+fine = foldl (\x y -> insertMinList x $ Down y)
+             (newMinList $ Down 0) [-1,-2,-3,-4,1,2,3,4]
+
+bad :: MinList Int
+bad = intIso fine
+
diff --git a/tests/deSugar/should_run/T5472.stdout b/tests/deriving/should_fail/T5498.stderr
similarity index 100%
copy from tests/deSugar/should_run/T5472.stdout
copy to tests/deriving/should_fail/T5498.stderr
diff --git a/tests/deriving/should_fail/all.T b/tests/deriving/should_fail/all.T
index 8b90e74..b2b99ff 100644
--- a/tests/deriving/should_fail/all.T
+++ b/tests/deriving/should_fail/all.T
@@ -47,3 +47,4 @@ test('T4846', normal, compile_fail, [''])
 test('T7148', normal, compile_fail, [''])
 test('T7148a', normal, compile_fail, [''])
 test('T7800', normal, multimod_compile_fail, ['T7800',''])
+test('T5498', normal, compile_fail, [''])