diff options
38 files changed, 397 insertions, 62 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0c6639a048..043174f3b0 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -482,6 +482,7 @@ data WarningFlag = | Opt_WarnAlternativeLayoutRuleTransitional | Opt_WarnUnsafe | Opt_WarnSafe + | Opt_WarnTrustworthySafe | Opt_WarnPointlessPragmas | Opt_WarnUnsupportedCallingConventions | Opt_WarnUnsupportedLlvmVersion @@ -778,6 +779,7 @@ data DynFlags = DynFlags { pkgTrustOnLoc :: SrcSpan, warnSafeOnLoc :: SrcSpan, warnUnsafeOnLoc :: SrcSpan, + trustworthyOnLoc :: SrcSpan, -- Don't change this without updating extensionFlags: extensions :: [OnOff ExtensionFlag], -- extensionFlags should always be equal to @@ -1466,6 +1468,7 @@ defaultDynFlags mySettings = pkgTrustOnLoc = noSrcSpan, warnSafeOnLoc = noSrcSpan, warnUnsafeOnLoc = noSrcSpan, + trustworthyOnLoc = noSrcSpan, extensions = [], extensionFlags = flattenExtensionFlags Nothing [], @@ -1758,11 +1761,15 @@ setSafeHaskell s = updM f where f dfs = do let sf = safeHaskell dfs safeM <- combineSafeFlags sf s - return $ case (s == Sf_Safe || s == Sf_Unsafe) of - True -> dfs { safeHaskell = safeM, safeInfer = False } + case s of + Sf_Safe -> return $ dfs { safeHaskell = safeM, safeInfer = False } -- leave safe inferrence on in Trustworthy mode so we can warn -- if it could have been inferred safe. - False -> dfs { safeHaskell = safeM } + Sf_Trustworthy -> do + l <- getCurLoc + return $ dfs { safeHaskell = safeM, trustworthyOnLoc = l } + -- leave safe inference on in Unsafe mode as well. + _ -> return $ dfs { safeHaskell = safeM } -- | Are all direct imports required to be safe for this Safe Haskell mode? -- Direct imports are when the code explicitly imports a module @@ -2663,6 +2670,7 @@ fWarningFlags = [ ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, nop ), ( "warn-pointless-pragmas", Opt_WarnPointlessPragmas, nop ), ( "warn-safe", Opt_WarnSafe, setWarnSafe ), + ( "warn-trustworthy-safe", Opt_WarnTrustworthySafe, nop ), ( "warn-tabs", Opt_WarnTabs, nop ), ( "warn-type-defaults", Opt_WarnTypeDefaults, nop ), ( "warn-typed-holes", Opt_WarnTypedHoles, nop ), diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index bec66f858a..c9baa5ac3e 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -412,19 +412,27 @@ tcRnModule' hsc_env sum save_rn_syntax mod = do -- end of the safe haskell line, how to respond to user? if not (safeHaskellOn dflags) || (safeInferOn dflags && not allSafeOK) -- if safe Haskell off or safe infer failed, mark unsafe - then markUnsafe tcg_res emptyBag + then markUnsafeInfer tcg_res emptyBag -- module (could be) safe, throw warning if needed else do tcg_res' <- hscCheckSafeImports tcg_res safe <- liftIO $ readIORef (tcg_safeInfer tcg_res') - when (safe && wopt Opt_WarnSafe dflags) - (logWarnings $ unitBag $ mkPlainWarnMsg dflags - (warnSafeOnLoc dflags) $ errSafe tcg_res') + when safe $ do + case wopt Opt_WarnSafe dflags of + True -> (logWarnings $ unitBag $ mkPlainWarnMsg dflags + (warnSafeOnLoc dflags) $ errSafe tcg_res') + False | safeHaskell dflags == Sf_Trustworthy && + wopt Opt_WarnTrustworthySafe dflags -> + (logWarnings $ unitBag $ mkPlainWarnMsg dflags + (trustworthyOnLoc dflags) $ errTwthySafe tcg_res') + False -> return () return tcg_res' where pprMod t = ppr $ moduleName $ tcg_mod t errSafe t = quotes (pprMod t) <+> text "has been inferred as safe!" + errTwthySafe t = quotes (pprMod t) + <+> text "is marked as Trustworthy but has been inferred as safe!" -- | Convert a typechecked module to Core hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts @@ -762,6 +770,18 @@ hscFileFrontEnd mod_summary = do -- * For modules explicitly marked -XSafe, we throw the errors. -- * For unmarked modules (inference mode), we drop the errors -- and mark the module as being Unsafe. +-- +-- It used to be that we only did safe inference on modules that had no Safe +-- Haskell flags, but now we perform safe inference on all modules as we want +-- to allow users to set the `--fwarn-safe`, `--fwarn-unsafe` and +-- `--fwarn-trustworthy-safe` flags on Trustworthy and Unsafe modules so that a +-- user can ensure their assumptions are correct and see reasons for why a +-- module is safe or unsafe. +-- +-- This is tricky as we must be careful when we should throw an error compared +-- to just warnings. For checking safe imports we manage it as two steps. First +-- we check any imports that are required to be safe, then we check all other +-- imports to see if we can infer them to be safe. -- | Check that the safe imports of the module being compiled are valid. @@ -772,21 +792,24 @@ hscCheckSafeImports :: TcGblEnv -> Hsc TcGblEnv hscCheckSafeImports tcg_env = do dflags <- getDynFlags tcg_env' <- checkSafeImports dflags tcg_env - case safeLanguageOn dflags of - True -> do - -- XSafe: we nuke user written RULES - logWarnings $ warns dflags (tcg_rules tcg_env') - return tcg_env' { tcg_rules = [] } - False - -- SafeInferred: user defined RULES, so not safe - | safeInferOn dflags && not (null $ tcg_rules tcg_env') - -> markUnsafe tcg_env' $ warns dflags (tcg_rules tcg_env') - - -- Trustworthy OR SafeInferred: with no RULES - | otherwise - -> return tcg_env' + checkRULES dflags tcg_env' where + checkRULES dflags tcg_env' = do + case safeLanguageOn dflags of + True -> do + -- XSafe: we nuke user written RULES + logWarnings $ warns dflags (tcg_rules tcg_env') + return tcg_env' { tcg_rules = [] } + False + -- SafeInferred: user defined RULES, so not safe + | safeInferOn dflags && not (null $ tcg_rules tcg_env') + -> markUnsafeInfer tcg_env' $ warns dflags (tcg_rules tcg_env') + + -- Trustworthy OR SafeInferred: with no RULES + | otherwise + -> return tcg_env' + warns dflags rules = listToBag $ map (warnRules dflags) rules warnRules dflags (L loc (HsRule n _ _ _ _ _ _)) = mkPlainWarnMsg dflags loc $ @@ -808,51 +831,55 @@ hscCheckSafeImports tcg_env = do checkSafeImports :: DynFlags -> TcGblEnv -> Hsc TcGblEnv checkSafeImports dflags tcg_env = do + imps <- mapM condense imports' + let (safeImps, regImps) = partition (\(_,_,s) -> s) imps + -- We want to use the warning state specifically for detecting if safe -- inference has failed, so store and clear any existing warnings. oldErrs <- getWarnings clearWarnings - imps <- mapM condense imports' - pkgs <- mapM checkSafe imps - - -- grab any safe haskell specific errors and restore old warnings - errs <- getWarnings + -- Check safe imports are correct + safePkgs <- mapM checkSafe safeImps + safeErrs <- getWarnings clearWarnings - logWarnings oldErrs + -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] - case (not $ isEmptyBag errs) of - - -- We have errors! - True -> - -- did we fail safe inference or fail -XSafe? - case safeInferOn dflags of - True -> markUnsafe tcg_env errs - False -> liftIO . throwIO . mkSrcErr $ errs - - -- All good matey! - False -> do - when (packageTrustOn dflags) $ checkPkgTrust dflags pkg_reqs - -- add in trusted package requirements for this module - let new_trust = emptyImportAvails { imp_trust_pkgs = catMaybes pkgs } - return tcg_env { tcg_imports = imp_info `plusImportAvails` new_trust } + (infErrs, infPkgs) <- case (safeInferOn dflags) of + False -> return (emptyBag, []) + True -> do infPkgs <- mapM checkSafe regImps + infErrs <- getWarnings + clearWarnings + return (infErrs, infPkgs) + + -- restore old errors + logWarnings oldErrs + + case (isEmptyBag safeErrs) of + -- Failed safe check + False -> liftIO . throwIO . mkSrcErr $ safeErrs + + -- Passed safe check + True -> do + let infPassed = isEmptyBag infErrs + tcg_env' <- case (not infPassed) of + True -> markUnsafeInfer tcg_env infErrs + False -> return tcg_env + when (packageTrustOn dflags) $ checkPkgTrust dflags pkgReqs + let newTrust = pkgTrustReqs safePkgs infPkgs infPassed + return tcg_env' { tcg_imports = impInfo `plusImportAvails` newTrust } where - imp_info = tcg_imports tcg_env -- ImportAvails - imports = imp_mods imp_info -- ImportedMods + impInfo = tcg_imports tcg_env -- ImportAvails + imports = imp_mods impInfo -- ImportedMods imports' = moduleEnvToList imports -- (Module, [ImportedModsVal]) - pkg_reqs = imp_trust_pkgs imp_info -- [PackageKey] + pkgReqs = imp_trust_pkgs impInfo -- [PackageKey] condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport) condense (_, []) = panic "HscMain.condense: Pattern match failure!" condense (m, x:xs) = do (_,_,l,s) <- foldlM cond' x xs - -- we turn all imports into safe ones when - -- inference mode is on. - let s' = if safeInferOn dflags && - safeHaskell dflags == Sf_None - then True else s - return (m, l, s') + return (m, l, s) -- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport) cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal @@ -865,8 +892,17 @@ checkSafeImports dflags tcg_env = return v1 -- easier interface to work with - checkSafe (_, _, False) = return Nothing - checkSafe (m, l, True ) = fst `fmap` hscCheckSafe' dflags m l + checkSafe (m, l, _) = fst `fmap` hscCheckSafe' dflags m l + + -- what pkg's to add to our trust requirements + pkgTrustReqs req inf infPassed | safeInferOn dflags + && safeHaskell dflags == Sf_None && infPassed + = emptyImportAvails { + imp_trust_pkgs = catMaybes req ++ catMaybes inf + } + pkgTrustReqs _ _ _ | safeHaskell dflags == Sf_Unsafe + = emptyImportAvails + pkgTrustReqs req _ _ = emptyImportAvails { imp_trust_pkgs = catMaybes req } -- | Check that a module is safe to import. -- @@ -1000,11 +1036,16 @@ checkPkgTrust dflags pkgs = -- | Set module to unsafe and (potentially) wipe trust information. -- --- Make sure to call this method to set a module to inferred unsafe, --- it should be a central and single failure method. We only wipe the trust --- information when we aren't in a specific Safe Haskell mode. -markUnsafe :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv -markUnsafe tcg_env whyUnsafe = do +-- Make sure to call this method to set a module to inferred unsafe, it should +-- be a central and single failure method. We only wipe the trust information +-- when we aren't in a specific Safe Haskell mode. +-- +-- While we only use this for recording that a module was inferred unsafe, we +-- may call it on modules using Trustworthy or Unsafe flags so as to allow +-- warning flags for safety to function correctly. See Note [Safe Haskell +-- Inference]. +markUnsafeInfer :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv +markUnsafeInfer tcg_env whyUnsafe = do dflags <- getDynFlags when (wopt Opt_WarnUnsafe dflags) diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.hs b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.hs index deb0d57f8d..107881b2d8 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.hs +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE NoImplicitPrelude #-} -module ImpSafe ( MyWord ) where +module ImpSafe01 ( MyWord ) where -- While Data.Word is safe it imports trustworthy -- modules in base, hence base needs to be trusted. diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs index deb0d57f8d..c6ba0968d0 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE NoImplicitPrelude #-} -module ImpSafe ( MyWord ) where +module ImpSafe02 ( MyWord ) where -- While Data.Word is safe it imports trustworthy -- modules in base, hence base needs to be trusted. diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.hs b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.hs new file mode 100644 index 0000000000..485e9e238c --- /dev/null +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Trustworthy #-} +module Main where + +import safe Prelude +import safe ImpSafe03_A + +main = putStrLn "test" + diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.stderr new file mode 100644 index 0000000000..2fdf45ce13 --- /dev/null +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.stderr @@ -0,0 +1,4 @@ +[2 of 2] Compiling Main ( ImpSafe03.hs, ImpSafe03.o ) + +<no location info>: + The package (bytestring-0.10.4.0) is required to be trusted but it isn't! diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03_A.hs b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03_A.hs new file mode 100644 index 0000000000..06f5d39754 --- /dev/null +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe03_A.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Trustworthy #-} +module ImpSafe03_A where + +import safe Prelude +import safe qualified Data.ByteString.Char8 as BS + +s = BS.pack "Hello World" + diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.hs b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.hs new file mode 100644 index 0000000000..3a8882905f --- /dev/null +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +module ImpSafe04 ( MyWord ) where + +-- While Data.Word is safe it imports trustworthy +-- modules in base, hence base needs to be trusted. +-- Note: Worthwhile giving out better error messages for cases +-- like this if I can. +import safe Data.Word +import System.IO.Unsafe + +type MyWord = Word + diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr new file mode 100644 index 0000000000..50a12e027b --- /dev/null +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr @@ -0,0 +1,4 @@ + +ImpSafe04.hs:9:1: + Data.Word: Can't be safely imported! + The package (base-4.8.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/check/pkg01/all.T b/testsuite/tests/safeHaskell/check/pkg01/all.T index f121b99add..e1ed80dd7c 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/all.T +++ b/testsuite/tests/safeHaskell/check/pkg01/all.T @@ -51,6 +51,15 @@ test('ImpSafe01', normal, compile_fail, ['-fpackage-trust -distrust base']) # Succeed since we don't enable package trust test('ImpSafe02', normal, compile, ['-distrust base']) +# Fail since we don't trust base of bytestring +test('ImpSafe03', normal, multi_compile_fail, + ['ImpSafe03 -trust base -distrust bytestring', [ + ('ImpSafe03_A.hs', ' -trust base -trust bytestring') + ], '-fpackage-trust' ]) + +# Fail same as ImpSafe01 but testing with -XTrustworthy now +test('ImpSafe04', normal, compile_fail, ['-fpackage-trust -distrust base']) + test('ImpSafeOnly01', [pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly01 ' + make_args), clean_cmd('$MAKE -s --no-print-directory cleanPackageDatabase.ImpSafeOnly01')], @@ -95,7 +104,7 @@ test('ImpSafeOnly07', clean_cmd('$MAKE -s --no-print-directory cleanPackageDatabase.ImpSafeOnly07'), normalise_errmsg_fun(normaliseBytestringPackage)], compile_fail, - ['-fpackage-trust -package-db pdb.ImpSafeOnly07/local.db -trust safePkg01']) + ['-fpackage-trust -package-db pdb.ImpSafeOnly07/local.db -trust safePkg01 -distrust bytestring']) test('ImpSafeOnly08', [pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly08 ' + make_args), clean_cmd('$MAKE -s --no-print-directory cleanPackageDatabase.ImpSafeOnly08'), diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.hs b/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.hs new file mode 100644 index 0000000000..507367929b --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE Unsafe #-} +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} +{-# OPTIONS_GHC -fenable-rewrite-rules #-} + +-- | Trivial Safe Module +module SafeWarn01 where + +g :: Int +g = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr b/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr new file mode 100644 index 0000000000..e9849d9eef --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr @@ -0,0 +1,3 @@ + +SafeWarn01.hs:2:16: Warning: + ‘SafeWarn01’ has been inferred as safe! diff --git a/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe01.hs b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe01.hs new file mode 100644 index 0000000000..6d65130a84 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe01.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE Trustworthy #-} + +-- | This module is marked trustworthy but should be inferable as -XSafe. +-- But no warning enabled. +module TrustworthySafe01 where + +g :: Int +g = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.hs b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.hs new file mode 100644 index 0000000000..9dfaccd950 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fwarn-trustworthy-safe #-} + +-- | This module is marked trustworthy but should be inferable as -XSafe. +-- Warning enabled. +module TrustworthySafe02 where + +g :: Int +g = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.stderr b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.stderr new file mode 100644 index 0000000000..68bf4e998e --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.stderr @@ -0,0 +1,3 @@ + +TrustworthySafe02.hs:1:14: Warning: + ‘TrustworthySafe02’ is marked as Trustworthy but has been inferred as safe! diff --git a/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe04.hs b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe04.hs new file mode 100644 index 0000000000..0b96de1d2a --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/TrustworthySafe04.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -W -fno-warn-trustworthy-safe #-} + +-- | This module is marked trustworthy but should be inferable as -XSafe. +-- Warning enabled through `-W` but then disabled with `-fno-warn...`. +module TrustworthySafe04 where + +g :: Int +g = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.hs new file mode 100644 index 0000000000..afe188db4f --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} + +-- | Trivial Unsafe Module +module UnsafeWarn01 where + +import System.IO.Unsafe + +f :: IO a -> a +f = unsafePerformIO + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr new file mode 100644 index 0000000000..1ef043a9fd --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr @@ -0,0 +1,7 @@ + +UnsafeWarn01.hs:2:16: Warning: + ‘UnsafeWarn01’ has been inferred as unsafe! + Reason: + UnsafeWarn01.hs:7:1: + System.IO.Unsafe: Can't be safely imported! + The module itself isn't safe. diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.hs new file mode 100644 index 0000000000..6f62ca5c94 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} + +{-# LANGUAGE TemplateHaskell #-} +-- | Unsafe as uses TH +module UnsafeWarn02 where + +f :: Int +f = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr new file mode 100644 index 0000000000..7421ad0333 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr @@ -0,0 +1,6 @@ + +UnsafeWarn02.hs:2:16: Warning: + ‘UnsafeWarn02’ has been inferred as unsafe! + Reason: + UnsafeWarn02.hs:4:14: + -XTemplateHaskell is not allowed in Safe Haskell diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.hs new file mode 100644 index 0000000000..ded02de888 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} + +-- | Trivial Unsafe Module +module UnsafeWarn03 where + +import System.IO.Unsafe + +f :: IO a -> a +f = unsafePerformIO + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr new file mode 100644 index 0000000000..a3d44ba375 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr @@ -0,0 +1,7 @@ + +UnsafeWarn03.hs:3:16: Warning: + ‘UnsafeWarn03’ has been inferred as unsafe! + Reason: + UnsafeWarn03.hs:8:1: + System.IO.Unsafe: Can't be safely imported! + The module itself isn't safe. diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.hs new file mode 100644 index 0000000000..d8e8b84fa5 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fwarn-trustworthy-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} + +-- | Trivial Unsafe Module +module UnsafeWarn04 where + +import System.IO.Unsafe + +f :: IO a -> a +f = unsafePerformIO + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr new file mode 100644 index 0000000000..66deff4edc --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr @@ -0,0 +1,7 @@ + +UnsafeWarn04.hs:3:16: Warning: + ‘UnsafeWarn04’ has been inferred as unsafe! + Reason: + UnsafeWarn04.hs:8:1: + System.IO.Unsafe: Can't be safely imported! + The module itself isn't safe. diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.hs new file mode 100644 index 0000000000..76258d362b --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE Unsafe #-} +{-# OPTIONS_GHC -fwarn-trustworthy-safe #-} +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} +{-# OPTIONS_GHC -fenable-rewrite-rules #-} + +-- | Trivial Unsafe Module +module UnsafeWarn05 where + +import System.IO.Unsafe + +f :: IO a -> a +f = unsafePerformIO + +{-# RULES "g" g = undefined #-} +{-# NOINLINE [1] g #-} +g :: Int +g = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr new file mode 100644 index 0000000000..229ce3d56f --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr @@ -0,0 +1,14 @@ + +UnsafeWarn05.hs:4:16: Warning: + ‘UnsafeWarn05’ has been inferred as unsafe! + Reason: + UnsafeWarn05.hs:10:1: + System.IO.Unsafe: Can't be safely imported! + The module itself isn't safe. + +UnsafeWarn05.hs:4:16: Warning: + ‘UnsafeWarn05’ has been inferred as unsafe! + Reason: + UnsafeWarn05.hs:15:11: Warning: + Rule "g" ignored + User defined rules are disabled under Safe Haskell diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.hs new file mode 100644 index 0000000000..671a64822b --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -fenable-rewrite-rules #-} +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} + +-- | Unsafe as uses RULES +module UnsafeWarn06 where + +{-# RULES "f" f = undefined #-} +{-# NOINLINE [1] f #-} +f :: Int +f = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr new file mode 100644 index 0000000000..8fde73ee0b --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr @@ -0,0 +1,7 @@ + +UnsafeWarn06.hs:3:16: Warning: + ‘UnsafeWarn06’ has been inferred as unsafe! + Reason: + UnsafeWarn06.hs:8:11: Warning: + Rule "f" ignored + User defined rules are disabled under Safe Haskell diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.hs new file mode 100644 index 0000000000..43982939b8 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fenable-rewrite-rules #-} +{-# OPTIONS_GHC -fwarn-safe #-} +{-# OPTIONS_GHC -fwarn-unsafe #-} + +-- | Unsafe as uses RULES +module UnsafeWarn07 where + +{-# RULES "f" f = undefined #-} +{-# NOINLINE [1] f #-} +f :: Int +f = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr new file mode 100644 index 0000000000..c5c5e632d7 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr @@ -0,0 +1,7 @@ + +UnsafeWarn07.hs:4:16: Warning: + ‘UnsafeWarn07’ has been inferred as unsafe! + Reason: + UnsafeWarn07.hs:9:11: Warning: + Rule "f" ignored + User defined rules are disabled under Safe Haskell diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index c2222a3549..89062cd174 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -73,3 +73,20 @@ test('Mixed01', normal, compile_fail, ['']) test('Mixed02', normal, compile_fail, ['']) test('Mixed03', normal, compile_fail, ['']) +# Trustworthy Safe modules +test('TrustworthySafe01', normal, compile, ['']) +test('TrustworthySafe02', normal, compile, ['']) +test('TrustworthySafe04', normal, compile, ['']) + +# Check -fwarn-unsafe works +test('UnsafeWarn01', normal, compile, ['']) +test('UnsafeWarn02', normal, compile, ['']) +test('UnsafeWarn03', normal, compile, ['']) +test('UnsafeWarn04', normal, compile, ['']) +test('UnsafeWarn05', normal, compile, ['']) +test('UnsafeWarn06', normal, compile, ['']) +test('UnsafeWarn07', normal, compile, ['']) + +# Chck -fwa-safe works +test('SafeWarn01', normal, compile, ['']) + diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang18.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang18.hs new file mode 100644 index 0000000000..330a80d069 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang18.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 703 +{-# LANGUAGE Safe #-} +#endif +module SafeLang18 where + +#define p377 toPair + +data StrictPair a b = !a :*: !b + +toPair :: StrictPair a b -> (a, b) +toPair (x :*: y) = (x, y) +{-# INLINE p377 #-} + diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index 926c576434..8dad0efee6 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -51,6 +51,8 @@ test('SafeLang17', multimod_compile_fail, ['SafeLang17', '']) +test('SafeLang18', normal, compile, ['']) + # Test building a package, that trust values are set correctly # and can be changed correctly #test('SafeRecomp01', diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.hs b/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.hs index 18c50dfab8..d2688fab80 100644 --- a/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.hs +++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.hs @@ -2,7 +2,7 @@ -- | Import unsafe module Control.ST to make sure it fails module Main where -import Control.Monad.ST +import Control.Monad.ST.Unsafe f :: Int f = 2 diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.stderr b/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.stderr index d3f193cff7..aa8b5a57f4 100644 --- a/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.stderr +++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport08.stderr @@ -1,4 +1,4 @@ BadImport08.hs:5:1: - Control.Monad.ST: Can't be safely imported! + Control.Monad.ST.Unsafe: Can't be safely imported! The module itself isn't safe. diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport09.hs b/testsuite/tests/safeHaskell/unsafeLibs/BadImport09.hs new file mode 100644 index 0000000000..90d1c49090 --- /dev/null +++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport09.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE Safe #-} +-- | Import unsafe module Control.ST to make sure it fails +module Main where + +import Control.Monad.ST.Lazy.Unsafe + +f :: Int +f = 2 + +main :: IO () +main = putStrLn $ "X is: " ++ show f + diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport09.stderr b/testsuite/tests/safeHaskell/unsafeLibs/BadImport09.stderr new file mode 100644 index 0000000000..88556c8997 --- /dev/null +++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport09.stderr @@ -0,0 +1,4 @@ + +BadImport09.hs:5:1: + Control.Monad.ST.Lazy.Unsafe: Can't be safely imported! + The module itself isn't safe. diff --git a/testsuite/tests/safeHaskell/unsafeLibs/all.T b/testsuite/tests/safeHaskell/unsafeLibs/all.T index 4ed5aab700..03ca0e4d18 100644 --- a/testsuite/tests/safeHaskell/unsafeLibs/all.T +++ b/testsuite/tests/safeHaskell/unsafeLibs/all.T @@ -23,6 +23,7 @@ test('BadImport05', normal, compile_fail, ['']) test('BadImport06', normal, compile_fail, ['']) test('BadImport07', normal, compile_fail, ['']) test('BadImport08', normal, compile_fail, ['']) +test('BadImport09', normal, compile_fail, ['']) # check safe modules are marked safe test('GoodImport01', normal, compile, ['']) |