Commit a8a01e74 authored by Austin Seipp's avatar Austin Seipp

Fix #8745 - GND is now -XSafe compatible.

As discussed in the ticket, after the landing of #8773, GND is now
-XSafe compatible.

This fixes the test fallout as well. In particular SafeLang07 was
removed following in the steps of SafeLang06, since it no longer failed
from GND, but failed due to roles and was thus invalid.

The other tests were tweaked to use TemplateHaskell instead of GND in
order to trigger safety warnings.
Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 5023c917
......@@ -1734,10 +1734,7 @@ 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 = [("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
xopt Opt_GeneralizedNewtypeDeriving,
flip xopt_unset Opt_GeneralizedNewtypeDeriving),
("-XTemplateHaskell", thOnLoc,
unsafeFlags = [("-XTemplateHaskell", thOnLoc,
xopt Opt_TemplateHaskell,
flip xopt_unset Opt_TemplateHaskell)]
......
<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
<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’
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Unsafe as uses GND
module UnsafeInfered03_A where
......
{-# LANGUAGE Safe, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe, TemplateHaskell #-}
-- | Test SafeLanguage disables things
module SafeLang02 where
......
SafeLang02.hs:1:20:
Warning: -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
Warning: -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell
{-# 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
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.
{-# 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
......@@ -15,11 +15,10 @@ test('SafeLang03', normal, compile, [''])
test('SafeLang04', normal, compile_and_run, [''])
test('SafeLang05', normal, compile_and_run, [''])
# 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
# 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
test('SafeLang07', normal, compile_fail, [''])
test('SafeLang08', normal, compile_fail, [''])
test('SafeLang09',
[exit_code(1),
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment