Fixed PGF file overwriting issue reported by Peter, by refusing to overwrite any of the input pgf files. Maybe the right fix would be to read the PGF strictly?

1 files changed, 11 insertions, 3 deletions

diff --git a/src/GFC.hs b/src/GFC.hs
index 337acb87a..f856949d2 100644
--- a/src/GFC.hs
+++ b/src/GFC.hs
@@ -16,6 +16,7 @@ import GF.Data.ErrM
 import Data.Maybe
 import Data.Binary
 import System.FilePath
+import System.IO
 
 
 mainGFC :: Options -> [FilePath] -> IOE ()
@@ -35,6 +36,7 @@ compileSourceFiles opts fs =
        if flag optStopAfterPhase opts == Compile 
          then return ()
          else do pgf <- link opts cnc gr
+                 writePGF opts pgf
                  writeOutputs opts pgf
 
 compileCFFiles :: Options -> [FilePath] -> IOE ()
@@ -46,28 +48,34 @@ compileCFFiles opts fs =
        if flag optStopAfterPhase opts == Compile 
          then return ()
          else do pgf <- link opts cnc gr
+                 writePGF opts pgf
                  writeOutputs opts pgf
 
 unionPGFFiles :: Options -> [FilePath] -> IOE ()
 unionPGFFiles opts fs = 
     do pgfs <- mapM readPGFVerbose fs
        let pgf = foldl1 unionPGF pgfs
+           pgfFile = grammarName opts pgf <.> "pgf"
+       if pgfFile `elem` fs 
+         then putStrLnE $ "Refusing to overwrite " ++ pgfFile
+         else writePGF opts pgf
        writeOutputs opts pgf
   where readPGFVerbose f = putPointE Normal opts ("Reading " ++ f ++ "...") $ ioeIO $ readPGF f
 
 writeOutputs :: Options -> PGF -> IOE ()
 writeOutputs opts pgf = do
-  writePGF opts pgf
   sequence_ [writeOutput opts name str 
                  | fmt <- flag optOutputFormats opts, 
                    (name,str) <- exportPGF opts fmt pgf]
 
 writePGF :: Options -> PGF -> IOE ()
 writePGF opts pgf = do
-  let name = fromMaybe (prCId (absname pgf)) (flag optName opts)
-      outfile = name <.> "pgf"
+  let outfile = grammarName opts pgf <.> "pgf"
   putPointE Normal opts ("Writing " ++ outfile ++ "...") $ ioeIO $ encodeFile outfile pgf
 
+grammarName :: Options -> PGF -> String
+grammarName opts pgf = fromMaybe (prCId (absname pgf)) (flag optName opts)
+
 writeOutput :: Options -> FilePath-> String -> IOE ()
 writeOutput opts file str =
     do let path = case flag optOutputDir opts of