From a98f4aa4be7b72a310a8b5826e3cc82c7edb8f40 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Fri, 6 Dec 2013 15:43:34 +0000
Subject: Show relative file paths in error messages

This is to avoid one trivial reason for failures in the test suite.
---
 src/compiler/GF/Compile.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

(limited to 'src/compiler/GF/Compile.hs')

diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index 0e29192c6..b74fd340c 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -62,7 +62,8 @@ batchCompile opts files = do
 -- to compile a set of modules, e.g. an old GF or a .cf file
 compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
 compileSourceGrammar opts gr = do
-  (_,gr',_) <- foldM (\env -> compileSourceModule opts env Nothing)
+  cwd <- liftIO getCurrentDirectory
+  (_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing)
                      (0,emptySourceGrammar,Map.empty)
                      (modules gr)
   return gr'
@@ -132,6 +133,7 @@ compileOne opts env@(_,srcgr,_) file = do
 
   let path = dropFileName file
   let name = dropExtension file
+  cwd <- liftIO getCurrentDirectory
 
   case takeExtensions file of
 
@@ -145,7 +147,7 @@ compileOne opts env@(_,srcgr,_) file = do
 
        let sm1 = unsubexpModule sm0
        (sm,warnings) <- {- putPointE Normal opts "creating indirections" $ -}
-                        runCheck $ extendModule srcgr sm1
+                        runCheck $ extendModule cwd srcgr sm1
        warnOut opts warnings
 
        if flag optTagsOnly opts
@@ -166,22 +168,22 @@ compileOne opts env@(_,srcgr,_) file = do
              $ getSourceModule opts file
        intermOut opts (Dump Source) (ppModule Internal sm)
 
-       compileSourceModule opts env (Just file) sm
+       compileSourceModule opts cwd env (Just file) sm
   where
    isConcr (_,m) = isModCnc m && mstatus m /= MSIncomplete
 
-compileSourceModule :: Options -> CompileEnv -> Maybe FilePath -> SourceModule -> IOE CompileEnv
-compileSourceModule opts env@(k,gr,_) mb_gfFile mo@(i,mi) = do
+compileSourceModule :: Options -> FilePath -> CompileEnv -> Maybe FilePath -> SourceModule -> IOE CompileEnv
+compileSourceModule opts cwd env@(k,gr,_) mb_gfFile mo@(i,mi) = do
 
-  mo1  <- runPass Rebuild "" (rebuildModule gr mo)
-  mo1b <- runPass Extend "" (extendModule gr mo1)
+  mo1  <- runPass Rebuild "" (rebuildModule cwd gr mo)
+  mo1b <- runPass Extend "" (extendModule cwd gr mo1)
 
   case mo1b of
     (_,n) | not (isCompleteModule n) ->
       if tagsFlag then generateTags k mo1b else generateGFO k mo1b
     _ -> do
-      mo2 <- runPass Rename "renaming" $ renameModule gr mo1b
-      mo3 <- runPass TypeCheck "type checking" $ checkModule opts gr mo2
+      mo2 <- runPass Rename "renaming" $ renameModule cwd gr mo1b
+      mo3 <- runPass TypeCheck "type checking" $ checkModule opts cwd gr mo2
       if tagsFlag then generateTags k mo3 else compileCompleteModule k mo3
   where
     compileCompleteModule k mo3 = do
-- 
cgit v1.2.3