Add tests for Safe Haskell Typeable instances feature

12 files changed, 195 insertions, 2 deletions

diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang13.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang13.hs
new file mode 100644
index 0000000000..9be68a3abb
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang13.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+-- | This shows how to use typeable to perform unsafe
+-- casts. Basically its an example of what Safe Haskell
+-- should disallow. SafeLang14 will do that.
+module Main where
+
+import SafeLang13_A
+import Data.Typeable
+
+data H = H String deriving (Typeable, Show)
+
+data G = G Int deriving (Show)
+
+instance Typeable G where
+    typeOf _ = typeOf (undefined :: H)
+
+instance Typeable P where
+    typeOf _ = typeOf (undefined :: G)
+
+{-
+deriving instance Typeable G
+
+deriving instance Typeable P
+-}
+
+main = do
+    let h = H "Hello World"
+        g = G 1
+--        Just h' = (cast h) :: Maybe G
+        Just p' = (cast p) :: Maybe G
+        Just px = (cast $ incrG p') :: Maybe P
+    putStrLn $ show h
+    putStrLn $ show g
+--    putStrLn $ show h'
+    putStrLn $ showP p
+    putStrLn $ show p'
+    putStrLn $ showP px
+
+incrG :: G -> G
+incrG (G n) = G $ n + 1
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang13.stdout b/testsuite/tests/safeHaskell/safeLanguage/SafeLang13.stdout
new file mode 100644
index 0000000000..0be38993da
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang13.stdout
@@ -0,0 +1,5 @@
+H "Hello World"
+G 1
+Should be 3 := 3
+G 3
+Should be 3 := 4
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang13_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang13_A.hs
new file mode 100644
index 0000000000..c49b085502
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang13_A.hs
@@ -0,0 +1,19 @@
+module SafeLang13_A (IsoInt, h, showH, P, p, showP) where
+
+newtype IsoInt = I Int
+
+h :: IsoInt
+h = I 2
+
+showH :: String
+showH = let I n = h
+        in show n
+
+data P = P Int
+
+p :: P
+p = P 3
+
+showP :: P -> String
+showP (P n) = "Should be 3 := " ++ show n
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.hs
new file mode 100644
index 0000000000..9be68a3abb
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+-- | This shows how to use typeable to perform unsafe
+-- casts. Basically its an example of what Safe Haskell
+-- should disallow. SafeLang14 will do that.
+module Main where
+
+import SafeLang13_A
+import Data.Typeable
+
+data H = H String deriving (Typeable, Show)
+
+data G = G Int deriving (Show)
+
+instance Typeable G where
+    typeOf _ = typeOf (undefined :: H)
+
+instance Typeable P where
+    typeOf _ = typeOf (undefined :: G)
+
+{-
+deriving instance Typeable G
+
+deriving instance Typeable P
+-}
+
+main = do
+    let h = H "Hello World"
+        g = G 1
+--        Just h' = (cast h) :: Maybe G
+        Just p' = (cast p) :: Maybe G
+        Just px = (cast $ incrG p') :: Maybe P
+    putStrLn $ show h
+    putStrLn $ show g
+--    putStrLn $ show h'
+    putStrLn $ showP p
+    putStrLn $ show p'
+    putStrLn $ showP px
+
+incrG :: G -> G
+incrG (G n) = G $ n + 1
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr
new file mode 100644
index 0000000000..5430d9154f
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr
@@ -0,0 +1,8 @@
+[1 of 2] Compiling SafeLang13_A     ( SafeLang13_A.hs, SafeLang13_A.o )
+[2 of 2] Compiling Main             ( SafeLang14.hs, SafeLang14.o )
+
+SafeLang14.hs:14:10:
+    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
+
+SafeLang14.hs:17:10:
+    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14_A.hs
new file mode 100644
index 0000000000..c49b085502
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14_A.hs
@@ -0,0 +1,19 @@
+module SafeLang13_A (IsoInt, h, showH, P, p, showP) where
+
+newtype IsoInt = I Int
+
+h :: IsoInt
+h = I 2
+
+showH :: String
+showH = let I n = h
+        in show n
+
+data P = P Int
+
+p :: P
+p = P 3
+
+showP :: P -> String
+showP (P n) = "Should be 3 := " ++ show n
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.hs
new file mode 100644
index 0000000000..966de8f738
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+-- | This shows how to use typeable to perform unsafe
+-- casts. Basically its an example of what Safe Haskell
+-- should disallow. SafeLang14 will do that.
+module Main where
+
+import SafeLang13_A
+import Data.Typeable
+
+data H = H String deriving (Typeable, Show)
+
+data G = G Int deriving (Show)
+
+deriving instance Typeable G
+
+deriving instance Typeable P
+
+main = do
+    let h = H "Hello World"
+        g = G 1
+--        Just h' = (cast h) :: Maybe G
+        Just p' = (cast p) :: Maybe G
+        Just px = (cast $ incrG p') :: Maybe P
+    putStrLn $ show h
+    putStrLn $ show g
+--    putStrLn $ show h'
+    putStrLn $ showP p
+    putStrLn $ show p'
+    putStrLn $ showP px
+
+incrG :: G -> G
+incrG (G n) = G $ n + 1
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
new file mode 100644
index 0000000000..41fa100504
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
@@ -0,0 +1,2 @@
+SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Data.Maybe.Just p'
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stdout b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stdout
new file mode 100644
index 0000000000..451a58d0db
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stdout
@@ -0,0 +1,3 @@
+H "Hello World"
+G 1
+Should be 3 := 3
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15_A.hs
new file mode 100644
index 0000000000..c49b085502
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15_A.hs
@@ -0,0 +1,19 @@
+module SafeLang13_A (IsoInt, h, showH, P, p, showP) where
+
+newtype IsoInt = I Int
+
+h :: IsoInt
+h = I 2
+
+showH :: String
+showH = let I n = h
+        in show n
+
+data P = P Int
+
+p :: P
+p = P 3
+
+showP :: P -> String
+showP (P n) = "Should be 3 := " ++ show n
+
diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T
index 7074c0f75c..122050dcb3 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/all.T
+++ b/testsuite/tests/safeHaskell/safeLanguage/all.T
@@ -16,4 +16,7 @@ test('SafeLang09', exit_code(1), compile_and_run, [''])
 test('SafeLang10', normal, compile_fail, ['--make -trust base'])
 test('SafeLang11', req_interp, compile_and_run, ['--make -trust base'])
 test('SafeLang12', normal, compile_fail, ['--make -trust base'])
+test('SafeLang13', normal, compile_and_run, ['--make -trust base'])
+test('SafeLang14', normal, compile_fail, ['--make -trust base -XSafe'])
+test('SafeLang15', exit_code(1), compile_and_run, ['--make -trust base -XSafe'])
 
diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr b/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr
index b1fcc3ca09..54bb8ee020 100644
--- a/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr
+++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr
@@ -1,5 +1,5 @@
 [1 of 2] Compiling BadImport02_A    ( BadImport02_A.hs, BadImport02_A.o )
 [2 of 2] Compiling Main             ( BadImport03.hs, BadImport03.o )
 
-BadImport03.hs:8:1:
-    base:Data.Typeable can't be safely imported! The module itself isn't safe.
+BadImport03.hs:16:10:
+    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them