diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 53a55335106d9d005ec4e0636e0bdf07680d856b..053026bab0e4b7bcdacd853b8645bd44c93b5b0f 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1732,7 +1732,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 6ebe783322e237489532e496003d709509360b0d..9446e1df160c4bae3f0fb7698c5f090f3b8bddf6 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 e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..a5dab96c1ee2c4f4ffc5721356230c58d5589926 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 596c874083884b57351b795549a54819fa6b8681..233a1e18c70a302618e5f5949f4e01fb1100cb73 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 ff6490e915c3e565846f82d50fe3b22b5e03bee0..ea3202ed5d703361de36754a95762c0325957218 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 8bc3f3cd00422280b37ed57799aa39b3796cd999..9bf1c82a096d06db834ddedc00e6e982e16bea59 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 e1643ed32b01dc90bb3adcbfb02b3b2ae2c18c36..069e5be4e924c50fa1f6a79cc253ee6331368865 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 0000000000000000000000000000000000000000..006cd0ea087a8273e811e76e0f815adba46a6754 --- /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 0000000000000000000000000000000000000000..276c723203a068ce4bfcab584fa263a120110f3f --- /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 0000000000000000000000000000000000000000..6ef49d5946219151ef3af6ca642a9e7aaa88c6dc --- /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 dc968917fb5d33945e43d2b74eb4f511c7dc5737..59323485949c2f7751c15cd48834e9427d141b19 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),