Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/c838658103c644ef6c32e92025b1d4999aa0f9bd >--------------------------------------------------------------- commit c838658103c644ef6c32e92025b1d4999aa0f9bd Author: David Terei <[email protected]> Date: Mon Jun 6 13:45:46 2011 -0700 SafeHaskell: Fix validation errors when unsafe base used >--------------------------------------------------------------- compiler/ghci/RtClosureInspect.hs | 2 +- compiler/hsSyn/HsImpExp.lhs | 1 + compiler/main/InteractiveEval.hs | 6 +++++- compiler/utils/FastMutInt.lhs | 4 +++- compiler/utils/StringBuffer.lhs | 2 +- ghc/InteractiveUI.hs | 7 +++++-- 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 8e2c92c..358c7e6 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 58bc4b0..9dbb441 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 68685b6..1df5255 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 b27f9cf..3a18a13 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 326cb1c..3eb2f1f 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 7f95125..b4fc2aa 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 e250fa6..7831f53 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
