Add in `-fwarn-trustworthy-safe` flag.
authorDavid Terei <code@davidterei.com>
Fri, 7 Nov 2014 22:11:19 +0000 (14:11 -0800)
committerDavid Terei <code@davidterei.com>
Thu, 13 Nov 2014 00:09:33 +0000 (16:09 -0800)
This warns when a module marked as `-XTrustworthy` could have been
inferred as safe instead.

38 files changed:
compiler/main/DynFlags.hs
compiler/main/HscMain.hs
testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.hs
testsuite/tests/safeHaskell/check/pkg01/ImpSafe02.hs
testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/check/pkg01/ImpSafe03.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/check/pkg01/ImpSafe03_A.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/check/pkg01/all.T
testsuite/tests/safeHaskell/safeInfered/SafeWarn01.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/SafeWarn01.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/TrustworthySafe01.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/TrustworthySafe02.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/TrustworthySafe04.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn01.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn02.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn03.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn04.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/all.T
testsuite/tests/safeHaskell/safeLanguage/SafeLang18.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeLanguage/all.T
testsuite/tests/safeHaskell/unsafeLibs/BadImport08.hs
testsuite/tests/safeHaskell/unsafeLibs/BadImport08.stderr
testsuite/tests/safeHaskell/unsafeLibs/BadImport09.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/unsafeLibs/BadImport09.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/unsafeLibs/all.T

index 0c6639a..043174f 100644 (file)
@@ -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 ),
index bec66f8..c9baa5a 100644 (file)
@@ -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)
index deb0d57..107881b 100644 (file)
@@ -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.
index deb0d57..c6ba096 100644 (file)
@@ -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 (file)
index 0000000..485e9e2
--- /dev/null
@@ -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 (file)
index 0000000..2fdf45c
--- /dev/null
@@ -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 (file)
index 0000000..06f5d39
--- /dev/null
@@ -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 (file)
index 0000000..3a88829
--- /dev/null
@@ -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 (file)
index 0000000..50a12e0
--- /dev/null
@@ -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.
index f121b99..e1ed80d 100644 (file)
@@ -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 (file)
index 0000000..5073679
--- /dev/null
@@ -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 (file)
index 0000000..e9849d9
--- /dev/null
@@ -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 (file)
index 0000000..6d65130
--- /dev/null
@@ -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 (file)
index 0000000..9dfaccd
--- /dev/null
@@ -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 (file)
index 0000000..68bf4e9
--- /dev/null
@@ -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 (file)
index 0000000..0b96de1
--- /dev/null
@@ -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 (file)
index 0000000..afe188d
--- /dev/null
@@ -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 (file)
index 0000000..1ef043a
--- /dev/null
@@ -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 (file)
index 0000000..6f62ca5
--- /dev/null
@@ -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 (file)
index 0000000..7421ad0
--- /dev/null
@@ -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 (file)
index 0000000..ded02de
--- /dev/null
@@ -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 (file)
index 0000000..a3d44ba
--- /dev/null
@@ -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 (file)
index 0000000..d8e8b84
--- /dev/null
@@ -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 (file)
index 0000000..66deff4
--- /dev/null
@@ -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 (file)
index 0000000..76258d3
--- /dev/null
@@ -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 (file)
index 0000000..229ce3d
--- /dev/null
@@ -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 (file)
index 0000000..671a648
--- /dev/null
@@ -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 (file)
index 0000000..8fde73e
--- /dev/null
@@ -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 (file)
index 0000000..4398293
--- /dev/null
@@ -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 (file)
index 0000000..c5c5e63
--- /dev/null
@@ -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
index c2222a3..89062cd 100644 (file)
@@ -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 (file)
index 0000000..330a80d
--- /dev/null
@@ -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 #-}
+
index 926c576..8dad0ef 100644 (file)
@@ -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',
index 18c50df..d2688fa 100644 (file)
@@ -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
index d3f193c..aa8b5a5 100644 (file)
@@ -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 (file)
index 0000000..90d1c49
--- /dev/null
@@ -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 (file)
index 0000000..88556c8
--- /dev/null
@@ -0,0 +1,4 @@
+
+BadImport09.hs:5:1:
+    Control.Monad.ST.Lazy.Unsafe: Can't be safely imported!
+    The module itself isn't safe.
index 4ed5aab..03ca0e4 100644 (file)
@@ -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, [''])