Start testing #230

Although this all seems to work just fine, it _something_ does go wrong with
relocation, because when I add one more printf statement in defined_in_B things
break. I don't yet know why.

IdeSession/Cabal.hs

@@ -92,6 +92,9 @@ import qualified IdeSession.Strict.List as StrictList
 import qualified IdeSession.Strict.Map  as StrictMap
 import IdeSession.Util
 
+import Control.Concurrent
+import System.Directory
+
 -- TODO: factor out common parts of exe building and haddock generation
 -- after Cabal and the code that calls it are improved not to require
 -- the configure step, etc.
@@ -252,15 +255,16 @@ mkConfFlags ideDistDir configPackageDBStack progPathExtra =
 configureAndBuild :: BuildExeArgs
                   -> [(ModuleName, FilePath)]
                   -> IO ExitCode
-configureAndBuild BuildExeArgs{ bePackageDBStack = configPackageDBStack
-                              , beExtraPathDirs = configExtraPathDirs
-                              , beSourcesDir = ideSourcesDir
-                              , beDistDir = ideDistDir
+configureAndBuild BuildExeArgs{ bePackageDBStack   = configPackageDBStack
+                              , beExtraPathDirs    = configExtraPathDirs
+                              , beSourcesDir       = ideSourcesDir
+                              , beDistDir          = ideDistDir
                               , beRelativeIncludes = relativeIncludes
-                              , beGhcOpts = ghcOpts
-                              , beLibDeps = libDeps
-                              , beLoadedMs = loadedMs
+                              , beGhcOpts          = ghcOpts
+                              , beLibDeps          = libDeps
+                              , beLoadedMs         = loadedMs
                               , .. } ms = do
+  appendFile "/tmp/ghc.log" ("configureAndBuild: " ++ show ghcOpts ++ "\n")
   let mainDep = Package.Dependency pkgNameMain anyVersion
       exeDeps = mainDep : libDeps
       sourcesDirs = map (\path -> ideSourcesDir </> path)
@@ -302,6 +306,8 @@ configureAndBuild BuildExeArgs{ bePackageDBStack = configPackageDBStack
       preprocessors = []
       hookedBuildInfo = (Nothing, [])  -- we don't want to use hooks
   let confAndBuild = do
+        cwd <- getCurrentDirectory
+        appendFile "/tmp/ghc.log" ((show (cwd, gpDesc :: GenericPackageDescription, hookedBuildInfo :: HookedBuildInfo, confFlags :: Setup.ConfigFlags) ++ "\n") :: String)
         lbi <- configure (gpDesc, hookedBuildInfo) confFlags
         -- Setting @withPackageDB@ here is too late, @configure@ would fail
         -- already. Hence we set it in @mkConfFlags@ (can be reverted,

TestSuite/TestSuite/Tests/C.hs

@@ -1,9 +1,12 @@
 module TestSuite.Tests.C (testGroupC) where
 
+import Control.Monad
+import Data.List (intercalate)
 import Data.Monoid
 import System.Exit
 import Test.Tasty
 import Test.HUnit
+import qualified Data.ByteString.Lazy       as L
 import qualified Data.ByteString.Lazy.Char8 as L (unlines)
 import qualified Data.Text                  as T
 
@@ -20,6 +23,8 @@ testGroupC env = testGroup "Using C files" [
   , stdTest env "Errors in C file, then update C file (#201)"                     test_errorsThenUpdate
   , stdTest env "C header files in subdirectories (#212)"                         test_headersInSubdirs
   , stdTest env "C code writes to stdout (#210)"                                  test_stdout
+  , testGroup "Two C files (no cyclic dependencies)"     $ test_2        env
+--  , testGroup "Two C files (C files mutually dependent)" $ test_2_cyclic env
   ]
 
 test_Basic :: TestSuiteEnv -> Assertion
@@ -277,3 +282,96 @@ test_stdout env = withAvailableSession env $ \session -> do
        <> updateSourceFile "hello.c" cfile
        <> updateSourceFile "Main.hs" hsfile
 
+
+test_2 :: TestSuiteEnv -> [TestTree]
+test_2 = \env ->
+    [ stdTest env (describeSchedule s) (testSchedule s)
+    | s <- schedule updates
+    ]
+  where
+    describeSchedule :: Schedule (String, IdeSessionUpdate) -> String
+    describeSchedule = intercalate "; "
+                     . map (bracket . intercalate ", ")
+                     . map (map fst)
+
+    testSchedule :: Schedule (String, IdeSessionUpdate) -> TestSuiteEnv -> Assertion
+    testSchedule s env = withAvailableSession env $ \session -> do
+      -- Enable code generation
+      updateSessionD session (updateCodeGeneration True) 0
+
+      -- Execute each task in the schedule
+      -- (this may have errors until the very last one)
+      forM_ s $ \ts -> updateSessionD session (mconcat (map snd ts)) 3
+
+      -- But after the last one there should be no more errors
+      assertNoErrors session
+
+      -- Run the code
+      ra <- runStmt session "Main" "main"
+      (output, result) <- runWaitAll ra
+      assertEqual "" result RunOk
+      assertEqual "" output "In B\nIn A\n"
+
+    updates :: [(String, IdeSessionUpdate)]
+    updates = [
+        ( "Load a.c", updateSourceFile "a.c"     cfileA)
+      , ( "Load b.c", updateSourceFile "b.c"     cfileB)
+      , ( "Load .hs", updateSourceFile "Main.hs" hsfile)
+      ]
+
+    cfileA, cfileB, hsfile :: L.ByteString
+    cfileA = L.unlines $
+        [ "#include <stdio.h>"
+        , "void defined_in_A() {"
+        , "  printf(\"In A\\n\");"
+        , "}"
+        ]
+    cfileB = L.unlines $
+        [ "#include <stdio.h>"
+        , ""
+        , "void defined_in_A();"
+        , ""
+        , "void defined_in_B() {"
+        , "  printf(\"In B\\n\");"
+        , "  defined_in_A();"
+        , "}"
+        ]
+    hsfile = L.unlines $
+        [ "{-# LANGUAGE ForeignFunctionInterface #-}"
+        , "module Main where"
+        , "import System.IO"
+        , "foreign import ccall \"defined_in_B\" defined_in_B :: IO ()"
+        , "main = defined_in_B"
+        ]
+
+{-------------------------------------------------------------------------------
+  Auxiliary
+-------------------------------------------------------------------------------}
+
+bracket :: String -> String
+bracket s = "[" ++ s ++ "]"
+
+-- | Execute a bunch of tasks sequentially
+type Schedule a = [Task a]
+
+-- | Execute a bunch of operations concurrently (must be non-empty)
+type Task a = [a]
+
+schedule :: [a] -> [Schedule a]
+schedule []     = [[]]
+schedule (a:as) = let ss = schedule as
+                  in concat $ map (insertSomewhere [a]) ss
+                           ++ map (applySomewhere (a:)) ss
+
+-- | Apply a function to precisely one element in the list
+applySomewhere :: (a -> a) -> [a] -> [[a]]
+applySomewhere f = expandOne (return . f)
+
+-- | Insert an element somewhere in the list
+insertSomewhere :: a -> [a] -> [[a]]
+insertSomewhere x xs = (x:xs) : expandOne (: [x]) xs
+
+-- | Apply 'f' to precisely one element
+expandOne :: (a -> [a]) -> [a] -> [[a]]
+expandOne _ []     = []
+expandOne f (x:xs) = (f x ++ xs) : map (x :) (expandOne f xs)