summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-api/downsweep/OldModLocation.hs
blob: 153509f29efd1e9debc2148b31142d96a798fca2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE ViewPatterns #-}

import GHC
import GHC.Driver.Make
import GHC.Driver.Session
import GHC.Unit.Module.ModSummary (ExtendedModSummary(..))
import GHC.Unit.Finder

import Control.Monad.IO.Class (liftIO)
import Data.List (sort, stripPrefix)
import Data.Either

import System.Environment
import System.Directory
import System.IO

main :: IO ()
main = do
  libdir:args <- getArgs

  runGhc (Just libdir) $
    defaultErrorHandler defaultFatalMessager defaultFlushOut $ do

    dflags0 <- getSessionDynFlags
    logger <- getLogger
    (dflags1, _, _) <- parseDynamicFlags logger dflags0 $ map noLoc $
        [ "-i", "-i.", "-imydir"
        -- , "-v3"
        ] ++ args
    _ <- setSessionDynFlags dflags1

    liftIO $ mapM_ writeMod
      [ [ "module A where"
        , "import B"
        ]
      , [ "module B where"
        ]
      ]

    tgt <- guessTarget "A" Nothing
    setTargets [tgt]
    hsc_env <- getSession

    liftIO $ do

    _emss <- downsweep hsc_env [] [] False

    flushFinderCaches hsc_env
    createDirectoryIfMissing False "mydir"
    renameFile "B.hs" "mydir/B.hs"

    emss <- downsweep hsc_env [] [] False

    -- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with
    -- (ms_location old_summary) like summariseFile used to instead of
    -- using the 'location' parameter we'd end up using the old location of
    -- the "B" module in this test. Make sure that doesn't happen.

    hPrint stderr $ sort (map (ml_hs_file . ms_location) (map emsModSummary (rights emss)))

writeMod :: [String] -> IO ()
writeMod src@(head -> stripPrefix "module " -> Just (takeWhile (/=' ') -> mod))
  = writeFile (mod++".hs") $ unlines src