mirror of
https://github.com/haskell/ghcide.git
synced 2024-12-03 05:23:25 +03:00
Pass correct SafeHaskell information to mkIfaceTc (#489)
Seems like this was never implemented the first time, woops! Fixes #424
This commit is contained in:
parent
8ba58ccdf1
commit
7ecdd21874
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user