hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add custom matcher for "outputFile" field

Browse Source
This commit is contained in:
Alan Zimmerman 2017-05-03 14:20:13 +02:00
parent 57ff5a03de
commit 597ffd02ea
3 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
core/GhcMod/DynFlags.hs
View File

@ -104,6 +104,5 @@ deferErrors df = return $
deriveEqDynFlags [d| deriveEqDynFlags [d|
eqDynFlags :: DynFlags -> DynFlags -> [[(Bool, String)]] eqDynFlags :: DynFlags -> DynFlags -> [[(Bool, String)]]
-- eqDynFlags :: DynFlags -> DynFlags -> ([Bool], [String])
eqDynFlags = undefined eqDynFlags = undefined
|] |]

14
core/GhcMod/DynFlagsTH.hs
View File

@ -14,7 +14,6 @@
-- You should have received a copy of the GNU Affero General Public License -- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>. -- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP, TemplateHaskell #-} {-# LANGUAGE CPP, TemplateHaskell #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
@ -45,10 +44,6 @@ deriveEqDynFlags qds = do
a <- newName "a" a <- newName "a"
b <- newName "b" b <- newName "b"
-- let combFunc = [| \(bs,ss) -> (and bs, unwords ss) |]
-- e <- AppE (VarE 'and) . ListE <$> sequence (mapMaybe (eq a b) fs)
-- e <- AppE (combFunc) . ListE <$> sequence $ combFunc (catMaybes $ map (eq a b) fs)
e <- ListE <$> sequence (mapMaybe (eq a b) fs) e <- ListE <$> sequence (mapMaybe (eq a b) fs)
tysig@(SigD n _) :_ <- qds tysig@(SigD n _) :_ <- qds
@ -103,8 +98,6 @@ deriveEqDynFlags qds = do
[e| $(eqfn) $(return fa) $(return fb) |] [e| $(eqfn) $(return fa) $(return fb) |]
"extraPkgConfs" -> do "extraPkgConfs" -> do
-- let eqfn = [| let fn a' b' = and (zipWith eqpr (a' []) (b' []))
-- && length (a' []) == length (b' [])
let eqfn = [| let fn a' b' = cond a' b' let eqfn = [| let fn a' b' = cond a' b'
cond a' b' = zz ++ ll cond a' b' = zz ++ ll
@ -159,6 +152,13 @@ deriveEqDynFlags qds = do
[e| $(eqfn) $(return fa) $(return fb) |] [e| $(eqfn) $(return fa) $(return fb) |]
#endif #endif
"outputFile" -> do
let eqfn = [| let fn (Just f1) (Just f2) = [(f1 == f2, if f1 == f2 then "" else "outputFile changed")]
fn _ _ = [(True, "")] -- anything with a Nothing is fine.
in fn
|]
[e| $(eqfn) $(return fa) $(return fb) |]
"generalFlags" -> checkIntSet "generalFlags" "generalFlags" -> checkIntSet "generalFlags"
"warningFlags" -> checkIntSet "warningFlags" "warningFlags" -> checkIntSet "warningFlags"

2
core/GhcMod/Target.hs
View File

@ -86,9 +86,9 @@ initSession opts mdf = do
df <- liftIO $ hsc_dflags <$> readIORef hsc_env_ref df <- liftIO $ hsc_dflags <$> readIORef hsc_env_ref
changed <- changed <-
withLightHscEnv' (initDF crdl) $ \hsc_env -> do withLightHscEnv' (initDF crdl) $ \hsc_env -> do
gmLog GmDebug "initSession" $ text $ "outputFiles:" ++ show (outputFile $ hsc_dflags hsc_env, outputFile df)
let dfEq = concat $ hsc_dflags hsc_env `eqDynFlags` df let dfEq = concat $ hsc_dflags hsc_env `eqDynFlags` df
gmLog GmDebug "initSession" $ text $ "dfEq=" ++ (show $ filter (\t -> not (fst t)) dfEq) gmLog GmDebug "initSession" $ text $ "dfEq=" ++ (show $ filter (\t -> not (fst t)) dfEq)
-- gmLog GmDebug "initSession" $ text $ "dfEq=" ++ (show dfEq)
let eq = and $ map fst dfEq let eq = and $ map fst dfEq
-- return $ not $ hsc_dflags hsc_env `eqDynFlags` df -- return $ not $ hsc_dflags hsc_env `eqDynFlags` df
return $ not eq return $ not eq