diff options
| author | Austin Seipp <austin@well-typed.com> | 2015-11-20 07:26:42 -0600 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2015-11-20 07:27:05 -0600 |
| commit | a689c8edb1639669cb8df58092b8b77a0a581717 (patch) | |
| tree | 6b39f3fc3645e21ef5e40d96a38f76d2d9d033f0 /ghc | |
| parent | b72ca3e3fa54b80a2c376e259cd09df60c7106bf (diff) | |
| download | haskell-a689c8edb1639669cb8df58092b8b77a0a581717.tar.gz | |
ghci: don't let ctags/etags overwrite source files
A ource file which was accidently passed as parameter into `:ctags` or `:etags`
can be overwritten by tag data. This patch updates documentation to avoid
confusion in commands usage and prevents `collateAndWriteTags` from modifying
existing source files.
Reviewed By: thomie, bgamari, austin
Differential Revision: https://phabricator.haskell.org/D1471
GHC Trac Issues: #10989
Diffstat (limited to 'ghc')
| -rw-r--r-- | ghc/GhciTags.hs | 16 | ||||
| -rw-r--r-- | ghc/InteractiveUI.hs | 6 |
2 files changed, 16 insertions, 6 deletions
diff --git a/ghc/GhciTags.hs b/ghc/GhciTags.hs index b250637b07..fa94ea68fa 100644 --- a/ghc/GhciTags.hs +++ b/ghc/GhciTags.hs @@ -28,9 +28,11 @@ import MonadUtils import Data.Function import Data.Maybe import Data.Ord +import DriverPhases import Panic import Data.List import Control.Monad +import System.Directory import System.IO import System.IO.Error @@ -131,23 +133,31 @@ tagInfo dflags unqual exported kind name loc (showSDocForUser dflags unqual $ ftext (srcLocFile loc)) (srcLocLine loc) (srcLocCol loc) Nothing +-- throw an exception when someone tries to overwrite existing source file (fix for #10989) +writeTagsSafely :: FilePath -> String -> IO () +writeTagsSafely file str = do + dfe <- doesFileExist file + if dfe && isSourceFilename file + then throwGhcException (CmdLineError (file ++ " is existing source file. " ++ + "Please specify another file name to store tags data")) + else writeFile file str collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ()) -- ctags style with the Ex exresion being just the line number, Vim et al collateAndWriteTags CTagsWithLineNumbers file tagInfos = do let tags = unlines $ sort $ map showCTag tagInfos - tryIO (writeFile file tags) + tryIO (writeTagsSafely file tags) -- ctags style with the Ex exresion being a regex searching the line, Vim et al collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos let tags = unlines $ sort $ map showCTag $concat tagInfoGroups - tryIO (writeFile file tags) + tryIO (writeTagsSafely file tags) collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos let tagGroups = map processGroup tagInfoGroups - tryIO (writeFile file $ concat tagGroups) + tryIO (writeTagsSafely file $ concat tagGroups) where processGroup [] = throwGhcException (CmdLineError "empty tag file group??") diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 21eff8ff62..8f861eecac 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -244,13 +244,13 @@ defFullHelpText = " :cd <dir> change directory to <dir>\n" ++ " :cmd <expr> run the commands returned by <expr>::IO String\n" ++ " :complete <dom> [<rng>] <s> list completions for partial input string\n" ++ - " :ctags[!] [<file>] create tags file for Vi (default: \"tags\")\n" ++ + " :ctags[!] [<file>] create tags file <file> for Vi (default: \"tags\")\n" ++ " (!: use regex instead of line number)\n" ++ " :def <cmd> <expr> define command :<cmd> (later defined command has\n" ++ " precedence, ::<cmd> is always a builtin command)\n" ++ " :edit <file> edit file\n" ++ " :edit edit last module\n" ++ - " :etags [<file>] create tags file for Emacs (default: \"TAGS\")\n" ++ + " :etags [<file>] create tags file <file> for Emacs (default: \"TAGS\")\n" ++ " :help, :? display this list of commands\n" ++ " :info[!] [<name> ...] display information about the given names\n" ++ " (!: do not filter instances)\n" ++ @@ -265,7 +265,7 @@ defFullHelpText = " :reload[!] reload the current module set\n" ++ " (!: defer type errors)\n" ++ " :run function [<arguments> ...] run the function with the given arguments\n" ++ - " :script <filename> run the script <filename>\n" ++ + " :script <file> run the script <file>\n" ++ " :type <expr> show the type of <expr>\n" ++ " :undef <cmd> undefine user-defined command :<cmd>\n" ++ " :!<command> run the shell command <command>\n" ++ |