Pass correct SafeHaskell information to mkIfaceTc (#489)

Seems like this was never implemented the first time, woops!

Fixes #424
This commit is contained in:
Matthew Pickering 2020-03-19 12:49:46 +00:00 committed by GitHub
parent 8ba58ccdf1
commit 7ecdd21874
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 34 additions and 2 deletions

View File

@ -234,10 +234,11 @@ mkTcModuleResult
-> m TcModuleResult
mkTcModuleResult tcm = do
session <- getSession
let sf = modInfoSafe (tm_checked_module_info tcm)
#if MIN_GHC_API_VERSION(8,10,0)
iface <- liftIO $ mkIfaceTc session Sf_None details tcGblEnv
iface <- liftIO $ mkIfaceTc session sf details tcGblEnv
#else
(iface, _) <- liftIO $ mkIfaceTc session Nothing Sf_None details tcGblEnv
(iface, _) <- liftIO $ mkIfaceTc session Nothing sf details tcGblEnv
#endif
let mod_info = HomeModInfo iface details Nothing
return $ TcModuleResult tcm mod_info

View File

@ -63,6 +63,7 @@ main = defaultMainWithRerun $ testGroup "HIE"
, pluginTests
, preprocessorTests
, thTests
, safeTests
, unitTests
, haddockTests
, positionMappingTests
@ -1485,6 +1486,36 @@ preprocessorTests = testSessionWait "preprocessor" $ do
)
]
safeTests :: TestTree
safeTests =
testGroup
"SafeHaskell"
[ -- Test for https://github.com/digital-asset/ghcide/issues/424
testSessionWait "load" $ do
let sourceA =
T.unlines
["{-# LANGUAGE Trustworthy #-}"
,"module A where"
,"import System.IO.Unsafe"
,"import System.IO"
,"trustWorthyId :: a -> a"
,"trustWorthyId i = unsafePerformIO $ do"
," putStrLn \"I'm safe\""
," return i"]
sourceB =
T.unlines
["{-# LANGUAGE Safe #-}"
,"module B where"
,"import A"
,"safeId :: a -> a"
,"safeId = trustWorthyId"
]
_ <- openDoc' "A.hs" "haskell" sourceA
_ <- openDoc' "B.hs" "haskell" sourceB
expectNoMoreDiagnostics 1 ]
thTests :: TestTree
thTests =
testGroup