From 24943ee66d53fa8e603d58c675e87bd63cb7e090 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 24 Jun 2004 09:41:11 +0000 Subject: [PATCH] [project @ 2004-06-24 09:41:11 by simonmar] Correction to the construction of .hi filenames in dependency generation. Fixes sourceforge bug #978543 Merge to STABLE --- ghc/compiler/main/DriverMkDepend.hs | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs index 1a15ed8..87bdcd3 100644 --- a/ghc/compiler/main/DriverMkDepend.hs +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverMkDepend.hs,v 1.31 2003/11/17 14:23:38 simonmar Exp $ +-- $Id: DriverMkDepend.hs,v 1.32 2004/06/24 09:41:11 simonmar Exp $ -- -- GHC Driver -- @@ -23,7 +23,7 @@ import Module ( ModuleName, ModLocation(..), moduleNameUserString, isHomeModule ) import Finder ( findModule, hiBootExt, hiBootVerExt, mkHomeModLocation ) -import Util ( global ) +import Util ( global, maybePrefixMatch ) import Panic import DATA_IOREF ( IORef, readIORef, writeIORef ) @@ -165,9 +165,25 @@ doMkDependHSPhase basename suff input_fn escapeSpaces dep) genDep (dep, True {- is an hi file -}) = do hisuf <- readIORef v_Hi_suf - let dep_base = remove_suffix '.' dep - deps = (dep_base ++ hisuf) - : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes + let + -- In order to construct hi files with alternate suffixes, we + -- now have to find the "basename" of the hi file. This is + -- difficult because we can't just split the hi filename + -- at the last dot - the hisuf might have dots in it. So we + -- check whether the hi filename ends in hisuf, and if it does, + -- we strip off hisuf, otherwise we strip everything after the + -- last dot. + dep_base + | Just rest <- maybePrefixMatch rev_hisuf rev_dep + = reverse rest + | otherwise + = remove_suffix '.' dep + where + rev_hisuf = reverse hisuf + rev_dep = reverse dep + + deps = dep : map (\suf -> dep_base ++ suf ++ '_':hisuf) + extra_suffixes -- length objs should be == length deps sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps) -- 1.7.10.4