diff options
author | David Terei <davidterei@gmail.com> | 2011-06-06 13:45:46 -0700 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2011-06-17 20:40:34 -0700 |
commit | c838658103c644ef6c32e92025b1d4999aa0f9bd (patch) | |
tree | d38d76f235e20fb76f8321bd060fe57b45216c43 | |
parent | 4f9675b2e0533000aeda861f3b4c04dd9ad79970 (diff) | |
download | haskell-c838658103c644ef6c32e92025b1d4999aa0f9bd.tar.gz |
SafeHaskell: Fix validation errors when unsafe base used
-rw-r--r-- | compiler/ghci/RtClosureInspect.hs | 2 | ||||
-rw-r--r-- | compiler/hsSyn/HsImpExp.lhs | 1 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 6 | ||||
-rw-r--r-- | compiler/utils/FastMutInt.lhs | 4 | ||||
-rw-r--r-- | compiler/utils/StringBuffer.lhs | 2 | ||||
-rw-r--r-- | ghc/InteractiveUI.hs | 7 | ||||
-rw-r--r-- | mk/validate-settings.mk | 3 |
7 files changed, 19 insertions, 6 deletions
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 8e2c92cd37..358c7e63c3 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -66,7 +66,7 @@ import Data.List import qualified Data.Sequence as Seq import Data.Monoid import Data.Sequence (viewl, ViewL(..)) -import Foreign +import Foreign.Safe import System.IO.Unsafe --------------------------------------------- diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs index 58bc4b0464..9dbb4417ae 100644 --- a/compiler/hsSyn/HsImpExp.lhs +++ b/compiler/hsSyn/HsImpExp.lhs @@ -47,6 +47,7 @@ simpleImportDecl mn = ImportDecl { ideclName = noLoc mn, ideclPkgQual = Nothing, ideclSource = False, + ideclSafe = True, ideclQualified = False, ideclAs = Nothing, ideclHiding = Nothing diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 68685b6556..1df5255dbe 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -75,7 +75,11 @@ import System.Directory import Data.Dynamic import Data.List (find) import Control.Monad -import Foreign +#if __GLASGOW_HASKELL__ >= 701 +import Foreign.Safe +#else +import Foreign hiding (unsafePerformIO) +#endif import Foreign.C import GHC.Exts import Data.Array diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs index b27f9cf2c9..3a18a13501 100644 --- a/compiler/utils/FastMutInt.lhs +++ b/compiler/utils/FastMutInt.lhs @@ -26,9 +26,11 @@ module FastMutInt( #endif import GHC.Base -import GHC.Ptr #if __GLASGOW_HASKELL__ >= 701 +import GHC.Ptr.Safe import GHC.Ptr.Unsafe +#else +import GHC.Ptr #endif #else /* ! __GLASGOW_HASKELL__ */ diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs index 326cb1c3f9..3eb2f1f5bd 100644 --- a/compiler/utils/StringBuffer.lhs +++ b/compiler/utils/StringBuffer.lhs @@ -55,7 +55,7 @@ import System.IO.Unsafe ( unsafePerformIO ) import GHC.Exts #if __GLASGOW_HASKELL__ >= 701 -import Foreign +import Foreign.Safe #else import Foreign hiding ( unsafePerformIO ) #endif diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 7f95125331..b4fc2aa821 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -88,7 +88,7 @@ import Data.Char import Data.Array import Control.Monad as Monad import Text.Printf -import Foreign +import Foreign.Safe import GHC.Exts ( unsafeCoerce# ) import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) @@ -1336,7 +1336,10 @@ isSafeCmd m = -- recently-added module occurs last, it seems. case (as,bs) of (as@(_:_), _) -> isSafeModule $ last as - ([], bs@(_:_)) -> isSafeModule $ fst (last bs) + ([], bs@(_:_)) -> do + let i = last bs + m <- GHC.findModule (unLoc (ideclName i)) (ideclPkgQual i) + isSafeModule m ([], []) -> ghcError (CmdLineError ":issafe: no current module") _ -> ghcError (CmdLineError "syntax: :issafe <module>") diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index e250fa6fb4..7831f530a8 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -7,6 +7,9 @@ HADDOCK_DOCS = YES SRC_CC_OPTS += -Wall $(WERROR) SRC_HC_OPTS += -Wall $(WERROR) -H64m -O0 +# Safe by default +#SRC_HC_OPTS += -Dsh_SAFE_DEFAULT + GhcStage1HcOpts += -O GhcStage2HcOpts += -O |