Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/39e4c620c5c28956c6ed8188a39042697f09b1be

>---------------------------------------------------------------

commit 39e4c620c5c28956c6ed8188a39042697f09b1be
Author: David Terei <[email protected]>
Date:   Fri Jun 17 18:16:48 2011 -0700

    SafeHaskell: Fix some mistakes in trust checking.

>---------------------------------------------------------------

 compiler/main/DynFlags.hs |    4 +++-
 compiler/main/HscMain.lhs |   25 ++++++++++++++++++-------
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0bb7fe7..fb2bd4f 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -980,7 +980,9 @@ setLanguage l = upd f
                      }
 
 safeLanguageOn :: DynFlags -> Bool
-safeLanguageOn dflags = s == Sf_SafeLanguage || s == Sf_Safe
+safeLanguageOn dflags = s == Sf_SafeLanguage
+                     || s == Sf_TrustworthyWithSafeLanguage
+                     || s == Sf_Safe
                           where s = safeHaskell dflags
 
 -- | Test if SafeHaskell is on in some form
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index f9a2980..a8bb18d 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -787,8 +787,15 @@ hscFileFrontEnd mod_summary = do
                     -- we also nuke user written RULES.
                     logWarnings $ warns (tcg_rules tcg_env1)
                     return tcg_env1 { tcg_rules = [] }
-                else
-                    return tcg_env1
+                else do
+                    -- Wipe out trust required packages if the module isn't
+                    -- trusted. Not doing this doesn't cause any problems
+                    -- but means the hi file will say some pkgs should be
+                    -- trusted when they don't need to be (since its an
+                    -- untrusted module) and we don't force them to be.
+                    let imps  = tcg_imports tcg_env1
+                        imps' = imps { imp_trust_pkgs = [] }
+                    return tcg_env1 { tcg_imports = imps' }
 
         else
             return tcg_env
@@ -862,13 +869,17 @@ checkSafeImports dflags hsc_env tcg_env
             | otherwise                               = False
 
         -- | Check the package a module resides in is trusted.
-        -- Modules in the home package are trusted but otherwise
-        -- we check the packages trust flag.
-        packageTrusted :: Module -> Bool
-        packageTrusted m
+        -- Safe compiled modules are trusted without requiring
+        -- that their package is trusted. For trustworthy modules,
+        -- modules in the home package are trusted but otherwise
+        -- we check the package trust flag.
+        packageTrusted :: SafeHaskellMode -> Module -> Bool
+        packageTrusted Sf_Safe _ = True
+        packageTrusted _ m
             | isHomePkg m = True
             | otherwise   = trusted $ getPackageDetails (pkgState dflags)
                                                         (modulePackageId m)
+
         -- Is a module trusted? Return Nothing if True, or a String
         -- if it isn't, containing the reason it isn't
         isModSafe :: Module -> SrcSpan -> Hsc (Maybe SDoc)
@@ -887,7 +898,7 @@ checkSafeImports dflags hsc_env tcg_env
                         safeM = trust `elem` [Sf_Safe, Sf_Trustworthy,
                                             Sf_TrustworthyWithSafeLanguage]
                         -- check package is trusted
-                        safeP = packageTrusted m
+                        safeP = packageTrusted trust m
                     if safeM && safeP
                         then return Nothing
                         else return $ Just $ if safeM



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to