diff options
author | Austin Seipp <austin@well-typed.com> | 2014-03-23 23:45:22 -0500 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2014-03-24 00:38:53 -0500 |
commit | 8f7303774237a8b0787d98c5ab6f605e3e897f19 (patch) | |
tree | 3fa6c22395e4d6d7131b713f4c141673522ff148 | |
parent | 61654e55e9e7f65b876adf7416388134058b0d9a (diff) | |
download | haskell-8f7303774237a8b0787d98c5ab6f605e3e897f19.tar.gz |
Revert "Fix #8745 - GND is now -XSafe compatible."
See #8827 - for now, we're making GND unsafe again.
This also fixes the tests since they were originally not using the new
unicode quote style we're using.
This reverts commit a8a01e742434df11b830ab99af12d9045dfcbc4b.
11 files changed, 101 insertions, 8 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index dded24fba3..1662c9f82e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1741,7 +1741,10 @@ combineSafeFlags a b | a == Sf_SafeInferred = return b -- * function to test if the flag is on -- * function to turn the flag off unsafeFlags :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)] -unsafeFlags = [("-XTemplateHaskell", thOnLoc, +unsafeFlags = [("-XGeneralizedNewtypeDeriving", newDerivOnLoc, + xopt Opt_GeneralizedNewtypeDeriving, + flip xopt_unset Opt_GeneralizedNewtypeDeriving), + ("-XTemplateHaskell", thOnLoc, xopt Opt_TemplateHaskell, flip xopt_unset Opt_TemplateHaskell)] diff --git a/testsuite/tests/safeHaskell/ghci/p1.stderr b/testsuite/tests/safeHaskell/ghci/p1.stderr index 6ebe783322..9446e1df16 100644 --- a/testsuite/tests/safeHaskell/ghci/p1.stderr +++ b/testsuite/tests/safeHaskell/ghci/p1.stderr @@ -1,3 +1,6 @@ <no location info>: Warning: -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell + +<no location info>: Warning: + -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving diff --git a/testsuite/tests/safeHaskell/ghci/p16.stderr b/testsuite/tests/safeHaskell/ghci/p16.stderr index e69de29bb2..a5dab96c1e 100644 --- a/testsuite/tests/safeHaskell/ghci/p16.stderr +++ b/testsuite/tests/safeHaskell/ghci/p16.stderr @@ -0,0 +1,15 @@ + +<no location info>: Warning: + -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving + +<interactive>:16:29: + Can't make a derived instance of ‘Op T2’: + ‘Op’ is not a derivable class + Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the newtype declaration for ‘T2’ + +<interactive>:19:9: + Not in scope: data constructor ‘T2’ + Perhaps you meant ‘T1’ (line 13) + +<interactive>:22:4: Not in scope: ‘y’ diff --git a/testsuite/tests/safeHaskell/ghci/p16.stdout b/testsuite/tests/safeHaskell/ghci/p16.stdout index 596c874083..233a1e18c7 100644 --- a/testsuite/tests/safeHaskell/ghci/p16.stdout +++ b/testsuite/tests/safeHaskell/ghci/p16.stdout @@ -1,2 +1 @@ "t1" -"T" diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered03_A.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered03_A.hs index ff6490e915..ea3202ed5d 100644 --- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered03_A.hs +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered03_A.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Unsafe as uses GND module UnsafeInfered03_A where diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.hs index 8bc3f3cd00..9bf1c82a09 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.hs +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Safe, TemplateHaskell #-} +{-# LANGUAGE Safe, GeneralizedNewtypeDeriving #-} -- | Test SafeLanguage disables things module SafeLang02 where diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.stderr index e1643ed32b..069e5be4e9 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang02.stderr @@ -1,3 +1,3 @@ SafeLang02.hs:1:20: - Warning: -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell + Warning: -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.hs new file mode 100644 index 0000000000..006cd0ea08 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- Here we stop it succeeding (SAFE) + +-- | We use newtype to create an isomorphic type to Int +-- with a reversed Ord dictionary. We now use the MinList +-- API of Y1 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 Y1. +module Main where + +import SafeLang07_A + +class IntIso t where + intIso :: c t -> c Int + +instance IntIso Int where + intIso = id + +newtype Down a = Down a deriving (Eq, Show, IntIso) + +instance Ord a => Ord (Down a) where + compare (Down a) (Down b) = compare b a + +forceInt :: MinList Int -> MinList Int +forceInt = id + +a1, a2 :: MinList Int +a1 = foldl insertMinList (newMinList $ head nums) (tail nums) +a2 = forceInt $ intIso $ foldl (\x y -> insertMinList x $ Down y) (newMinList $ Down $ head nums) (tail nums) + +nums :: [Int] +nums = [1,4,0,1,-5,2,3,5,-1,2,0,0,-4,-3,9] + +main = do + printIntMinList a1 + printIntMinList a2 + diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr new file mode 100644 index 0000000000..276c723203 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr @@ -0,0 +1,7 @@ + +SafeLang07.hs:2:14: Warning: + -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving + +SafeLang07.hs:15:1: + Failed to load interface for ‘SafeLang07_A’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07_A.hs new file mode 100644 index 0000000000..6ef49d5946 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07_A.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE Trustworthy #-} + +-- | Here we expose a MinList API that only allows elements +-- to be inserted into a list if they are at least greater +-- than an initial element the list is created with. +module SafeLang07_A ( + MinList, + newMinList, + insertMinList, + printIntMinList + ) 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 + diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index dc968917fb..5932348594 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -15,10 +15,11 @@ test('SafeLang03', normal, compile, ['']) test('SafeLang04', normal, compile_and_run, ['']) test('SafeLang05', normal, compile_and_run, ['']) -# SafeLang06 and SafeLang07 wwere tests involving -# GeneralizedNewtypeDeriving, but the code failed to compile with -# roles; thus the tests were no longer valid and have been removed +# SafeLang06 was a test involving GeneralizedNewtypeDeriving, but the code +# fails to compile with roles; thus the test is no longer valid and has +# been removed +test('SafeLang07', normal, compile_fail, ['']) test('SafeLang08', normal, compile_fail, ['']) test('SafeLang09', [exit_code(1), |