Show relative file paths in error messages

This is to avoid one trivial reason for failures in the test suite.
This commit is contained in:
hallgren
2013-12-06 15:43:34 +00:00
parent e2fe50e585
commit a98f4aa4be
7 changed files with 63 additions and 63 deletions

View File

@@ -33,18 +33,20 @@ import Data.Char(isAscii)
import Control.Monad (foldM,when,unless)
import System.Cmd (system)
--import System.IO(mkTextEncoding) --,utf8
import System.Directory(removeFile)
import System.Directory(removeFile,getCurrentDirectory)
import System.FilePath(makeRelative)
getSourceModule :: Options -> FilePath -> IOE SourceModule
getSourceModule opts file0 =
errIn file0 $
--errIn file0 $
do tmp <- lift $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
raw <- lift $ keepTemp tmp
--ePutStrLn $ "1 "++file0
(optCoding,parsed) <- parseSource opts pModDef raw
case parsed of
Left (Pn l c,msg) -> do file <- lift $ writeTemp tmp
let location = file++":"++show l++":"++show c
cwd <- lift $ getCurrentDirectory
let location = makeRelative cwd file++":"++show l++":"++show c
raise (location++":\n "++msg)
Right (i,mi0) ->
do lift $ removeTemp tmp