From: Simon Marlow <simonmar@microsoft.com>
Date: Wed, 26 Sep 2007 13:45:39 +0000 (+0000)
Subject: FIX -stubdir bug: the .hc file was #including the wrong _stub.h filename
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=8af9e46751058eecc15d0251c5e250ebcb8367da

FIX -stubdir bug: the .hc file was #including the wrong _stub.h filename
Using -stubdir together with hierarchical modules, -fvia-C, and --make
is essentially broken in 6.6.x.  Recently discovered by Cabal's use of
-stubdir.

Test cases: driver027/driver028 (I've updated them to use -fvia-C, in
order to test for this bug).
---

diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index c5a8c79..6985bd7 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -151,10 +151,10 @@ outputC dflags filenm mod location flat_absC
 	  hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
 	  hPutStr h cc_injects
 	  when stub_h_exists $ 
-	     hPutStrLn h ("#include \"" ++ (filenameOf stub_h) ++ "\"")
+	     hPutStrLn h ("#include \"" ++ inc_stub_h ++ "\"")
 	  writeCs dflags h flat_absC
   where
-    (_, stub_h) = mkStubPaths dflags (moduleName mod) location
+    (_, _, inc_stub_h) = mkStubPaths dflags (moduleName mod) location
 \end{code}
 
 
@@ -265,7 +265,7 @@ outputForeignStubs dflags mod location stubs
 
         return (stub_h_file_exists, stub_c_file_exists)
   where
-   (stub_c, stub_h) = mkStubPaths dflags (moduleName mod) location
+   (stub_c, stub_h, _) = mkStubPaths dflags (moduleName mod) location
 
 cplusplus_hdr = "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
 cplusplus_ftr = "#ifdef __cplusplus\n}\n#endif\n"
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 22ce8c4..c6a2ee2 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -243,7 +243,7 @@ compileStub dflags mod location = do
 	    stub_o = o_base ++ "_stub" `joinFileExt` o_ext
 
 	-- compile the _stub.c file w/ gcc
-	let (stub_c,_) = mkStubPaths dflags (moduleName mod) location
+	let (stub_c,_,_) = mkStubPaths dflags (moduleName mod) location
 	runPipeline StopLn dflags (stub_c,Nothing)  Nothing
 		(SpecificFile stub_o) Nothing{-no ModLocation-}
 
@@ -644,7 +644,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
  = do	-- normal Hsc mode, not mkdependHS
 
   -- we add the current directory (i.e. the directory in which
-  -- the .hs files resides) to the import path, since this is
+  -- the .hs files resides) to the include path, since this is
   -- what gcc does, and it's probably what you want.
 	let current_dir = directoryOf basename
 	
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2062ed1..a16b8b3 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -574,9 +574,11 @@ getVerbFlag dflags
   | verbosity dflags >= 3  = "-v" 
   | otherwise =  ""
 
-setObjectDir  f d = d{ objectDir  = f}
-setHiDir      f d = d{ hiDir      = f}
-setStubDir    f d = d{ stubDir    = f}
+setObjectDir  f d = d{ objectDir  = Just f}
+setHiDir      f d = d{ hiDir      = Just f}
+setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
+  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
+  -- #included from the .hc file when compiling with -fvia-C.
 
 setObjectSuf  f d = d{ objectSuf  = f}
 setHiSuf      f d = d{ hiSuf      = f}
@@ -981,15 +983,15 @@ dynamic_flags = [
   ,  ( "framework"	, HasArg (upd . addCmdlineFramework) )
 
 	------- Output Redirection ------------------------------------------
-  ,  ( "odir"		, HasArg (upd . setObjectDir  . Just))
+  ,  ( "odir"		, HasArg (upd . setObjectDir))
   ,  ( "o"		, SepArg (upd . setOutputFile . Just))
   ,  ( "ohi"		, HasArg (upd . setOutputHi   . Just ))
   ,  ( "osuf"		, HasArg (upd . setObjectSuf))
   ,  ( "hcsuf"		, HasArg (upd . setHcSuf))
   ,  ( "hisuf"		, HasArg (upd . setHiSuf))
-  ,  ( "hidir"		, HasArg (upd . setHiDir . Just))
+  ,  ( "hidir"		, HasArg (upd . setHiDir))
   ,  ( "tmpdir"		, HasArg (upd . setTmpDir))
-  ,  ( "stubdir"	, HasArg (upd . setStubDir . Just))
+  ,  ( "stubdir"	, HasArg (upd . setStubDir))
   ,  ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just))
 
 	------- Keeping temporary files -------------------------------------
diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index 24c52bb..25bf90c 100644
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -468,7 +468,7 @@ mkStubPaths
   :: DynFlags
   -> ModuleName
   -> ModLocation
-  -> (FilePath,FilePath)
+  -> (FilePath,FilePath,FilePath)
 
 mkStubPaths dflags mod location
   = let
@@ -483,9 +483,23 @@ mkStubPaths dflags mod location
 			| otherwise           = src_basename
 
 		stub_basename = stub_basename0 ++ "_stub"
+
+                -- this is the filename we're going to use when
+                -- #including the stub_h file from the .hc file.
+                -- Without -stubdir, we just #include the basename
+                -- (eg. for a module A.B, we #include "B_stub.h"),
+                -- relying on the fact that we add an implicit -I flag
+                -- for the directory in which the source file resides
+                -- (see DriverPipeline.hs).  With -stubdir, we
+                -- #include "A/B.h", assuming that the user has added
+                -- -I<dir> along with -stubdir <dir>.
+                include_basename
+                        | Just _ <- stubdir = mod_basename 
+                        | otherwise         = filenameOf mod_basename
      in
         (stub_basename `joinFileExt` "c",
-	 stub_basename `joinFileExt` "h")
+	 stub_basename `joinFileExt` "h",
+         (include_basename ++ "_stub") `joinFileExt` "h")
 	-- the _stub.o filename is derived from the ml_obj_file.
 
 -- -----------------------------------------------------------------------------