From c96a613c98d07fab4facc77bdd0701b7a17d332a Mon Sep 17 00:00:00 2001 From: David Terei Date: Mon, 4 Aug 2014 17:41:54 -0400 Subject: Add in Incoherent Instances test for Safe Haskell. --- .../tests/safeHaskell/safeInfered/UnsafeInfered17.hs | 10 ++++++++++ .../safeHaskell/safeInfered/UnsafeInfered17.stderr | 9 +++++++++ testsuite/tests/safeHaskell/safeInfered/all.T | 1 + .../tests/safeHaskell/safeLanguage/SafeLang17.hs | 11 +++++++++++ .../tests/safeHaskell/safeLanguage/SafeLang17.stderr | 20 ++++++++++++++++++++ .../tests/safeHaskell/safeLanguage/SafeLang17_A.hs | 15 +++++++++++++++ .../tests/safeHaskell/safeLanguage/SafeLang17_B.hs | 19 +++++++++++++++++++ testsuite/tests/safeHaskell/safeLanguage/all.T | 5 +++++ 8 files changed, 90 insertions(+) create mode 100644 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.hs create mode 100644 testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.stderr create mode 100644 testsuite/tests/safeHaskell/safeLanguage/SafeLang17.hs create mode 100644 testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr create mode 100644 testsuite/tests/safeHaskell/safeLanguage/SafeLang17_A.hs create mode 100644 testsuite/tests/safeHaskell/safeLanguage/SafeLang17_B.hs (limited to 'testsuite') diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.hs new file mode 100644 index 0000000000..04591b5f77 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered15 where + +class C a where + f :: a -> String + +instance {-# INCOHERENT #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.stderr new file mode 100644 index 0000000000..415e9a1f37 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.stderr @@ -0,0 +1,9 @@ + +UnsafeInfered17.hs:1:16: Warning: + ‘UnsafeInfered15’ has been inferred as unsafe! + Reason: + UnsafeInfered17.hs:8:29: + [incoherent] overlap mode isn't allowed in Safe Haskell + +: +Failing due to -Werror. diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index a9600fa1c2..4fc9fcecb8 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -64,6 +64,7 @@ test('UnsafeInfered13', normal, compile_fail, ['']) test('UnsafeInfered14', normal, compile_fail, ['']) test('UnsafeInfered15', normal, compile_fail, ['']) test('UnsafeInfered16', normal, compile_fail, ['']) +test('UnsafeInfered17', normal, compile_fail, ['']) # Mixed tests test('Mixed01', normal, compile_fail, ['']) diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.hs new file mode 100644 index 0000000000..411addd00c --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE Trustworthy #-} +module Main where + +import SafeLang17_A -- trusted lib +import SafeLang17_B -- untrusted plugin + +main = do + let r = res [(1::Int)] + putStrLn $ "Result: " ++ show r + putStrLn $ "Result: " ++ show function + diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr new file mode 100644 index 0000000000..c59f86670a --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr @@ -0,0 +1,20 @@ +[1 of 3] Compiling SafeLang17_A ( SafeLang17_A.hs, SafeLang17_A.o ) +[2 of 3] Compiling SafeLang17_B ( SafeLang17_B.hs, SafeLang17_B.o ) +[3 of 3] Compiling Main ( SafeLang17.hs, SafeLang17.o ) + +SafeLang17.hs:8:13: + Unsafe overlapping instances for Pos [Int] + arising from a use of ‘res’ + The matching instance is: + instance [incoherent] [safe] Pos [Int] + -- Defined at SafeLang17_B.hs:14:10 + It is compiled in a Safe module and as such can only + overlap instances from the same module, however it + overlaps the following instances from different modules: + instance Pos [a] -- Defined at SafeLang17_A.hs:13:10 + In the expression: res [(1 :: Int)] + In an equation for ‘r’: r = res [(1 :: Int)] + In the expression: + do { let r = res ...; + putStrLn $ "Result: " ++ show r; + putStrLn $ "Result: " ++ show function } diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang17_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17_A.hs new file mode 100644 index 0000000000..0ce2bdf6b9 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17_A.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | Trusted library that unsafe plugins can use +module SafeLang17_A where + +class Pos a where + res :: a -> Bool + +-- Any call to res with a list in out TCB +-- should use this method and never a more +-- specific one provided by an untrusted module +instance Pos [a] where + res _ = True + diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang17_B.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17_B.hs new file mode 100644 index 0000000000..2059f01523 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17_B.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE IncoherentInstances #-} + +-- Untrusted plugin! Don't wan't it changing behaviour of our +-- trusted code +module SafeLang17_B where + +import SafeLang17_A + +instance Pos a where + res _ = False + +instance Pos [Int] where + res _ = error "This curry is poisoned!" + +function :: Int +function = 3 + diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index 131778bf52..926c576434 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -45,6 +45,11 @@ test('SafeLang15', multimod_compile_and_run, ['SafeLang15', '-XSafe']) test('SafeLang16', normal, compile, ['']) +test('SafeLang17', + extra_clean(['SafeLang17_A.o', 'SafeLang17_A.hi', + 'SafeLang17_B.o', 'SafeLang17_B.hi']), + multimod_compile_fail, + ['SafeLang17', '']) # Test building a package, that trust values are set correctly # and can be changed correctly -- cgit v1.2.1