git.iko.soy/project-m36
on master help sign in
ezyang helped to identify that the GHC API 8 loading issue was merely the order of package databases!
103b2aeAgentM
src/lib/ProjectM36/AtomFunctionBody.hs+11−6
compare with master
unifiedsplit
@@ -14,10 +14,11 @@ import GHC.Paths (libdir)
14import GHC.LanguageExtensions
14import GHC.LanguageExtensions
15import DynFlags
15import DynFlags
16import Panic
16import Panic
17−import Outputable hiding ((<>))
17+import Outputable --hiding ((<>))
18import PprTyThing
18import PprTyThing
19import Type hiding (pprTyThing)
19import Type hiding (pprTyThing)
20import System.FilePath.Glob
20import System.FilePath.Glob
21+import Debug.Trace
21
22
22data ScriptSession = ScriptSession {
23data ScriptSession = ScriptSession {
23 hscEnv :: HscEnv,
24 hscEnv :: HscEnv,
@@ -42,21 +43,25 @@ initScriptSession ghcPkgPaths = do
42 safeHaskell = Sf_Trustworthy,
43 safeHaskell = Sf_Trustworthy,
43 safeInfer = True,
44 safeInfer = True,
44 safeInferred = True,
45 safeInferred = True,
46+ --verbosity = 3,
47+#if __GLASGOW_HASKELL__ >= 800
45− --trustFlags = [TrustPackage "base"] -- new in 8
48+ trustFlags = map TrustPackage required_packages,
49+#endif
46 packageFlags = (packageFlags dflags) ++ packages,
50 packageFlags = (packageFlags dflags) ++ packages,
47− extraPkgConfs = const ([GlobalPkgConf, UserPkgConf] ++ localPkgPaths)
51+ extraPkgConfs = const (localPkgPaths ++ [UserPkgConf, GlobalPkgConf])
48 }
52 }
49 applyGopts flags = foldl gopt_set flags gopts
53 applyGopts flags = foldl gopt_set flags gopts
50 applyXopts flags = foldl xopt_set flags xopts
54 applyXopts flags = foldl xopt_set flags xopts
51#if __GLASGOW_HASKELL__ >= 800
55#if __GLASGOW_HASKELL__ >= 800
52 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]
56 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]
53− gopts = [Opt_DistrustAllPackages, Opt_PackageTrust]
54#else
57#else
55 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]
58 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]
56− gopts = [Opt_DistrustAllPackages, Opt_PackageTrust]
57#endif
59#endif
60+ gopts = [] --[Opt_DistrustAllPackages, Opt_PackageTrust]
58 required_packages = ["base",
61 required_packages = ["base",
59 "containers",
62 "containers",
63+ "Glob",
64+ "directory",
60 "unordered-containers",
65 "unordered-containers",
61 "hashable",
66 "hashable",
62 "uuid",
67 "uuid",
@@ -70,9 +75,9 @@ initScriptSession ghcPkgPaths = do
70#if __GLASGOW_HASKELL__ >= 800
75#if __GLASGOW_HASKELL__ >= 800
71 packages = map (\m -> ExposePackage ("-package " ++ m) (PackageArg m) (ModRenaming True [])) required_packages
76 packages = map (\m -> ExposePackage ("-package " ++ m) (PackageArg m) (ModRenaming True [])) required_packages
72#else
77#else
73−
74 packages = map TrustPackage required_packages
78 packages = map TrustPackage required_packages
75#endif
79#endif
80+ --liftIO $ traceShowM (showSDoc dflags' (ppr packages))
76 _ <- setSessionDynFlags dflags'
81 _ <- setSessionDynFlags dflags'
77 let safeImportDecl mn = ImportDecl {
82 let safeImportDecl mn = ImportDecl {
78 ideclSourceSrc = Nothing,
83 ideclSourceSrc = Nothing,
test/TutorialD/Interpreter/AtomFunctionScript.hs+3−2
@@ -37,9 +37,10 @@ testErrorAtomFunction = TestCase $ do
37 let attrs = [Attribute "x" IntAtomType]
37 let attrs = [Attribute "x" IntAtomType]
38 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntAtom 3)] ()
38 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntAtom 3)] ()
39 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
39 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
40− expectedResult = Left (UnhandledExceptionError "1")
41 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
40 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
42− assertEqual "catch error exception from script" expectedResult result
41+ assertBool "catch error exception from script" (case result of
42+ Left (UnhandledExceptionError _) -> True
43+ _ -> False)
43
44
44testNoArgumentAtomFunction :: Test
45testNoArgumentAtomFunction :: Test
45testNoArgumentAtomFunction = TestCase $ do
46testNoArgumentAtomFunction = TestCase $ do