[commit: ghc] master: Catch canonicalizePath exceptions, fix #10101 (4756438)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4756438962a76d2dcedf63b90ec789cb054f9556/ghc

>---------------------------------------------------------------

commit 4756438962a76d2dcedf63b90ec789cb054f9556
Author: Flaviu Andrei Csernik (archblob) <fcsernik at gmail.com>
Date:   Mon Jun 1 02:13:36 2015 -0500

    Catch canonicalizePath exceptions, fix #10101
    
    Summary:
    Introduce by #95 'canonicalizePath' throws and exception when given
    an invalid file in a call to 'sameFile'.
    
    There are two cases when this can happen when using ghci:
      1) If there is an error at the interactive prompt, "<interactive>"
         file is searched for and not found.
      2) If there is an error in any loaded file and editing an inexistent/new
         file with 'e: foo'.
    
    Both cases are now tested.
    
    Test Plan: validate
    
    Reviewers: austin, #ghc
    
    Reviewed By: austin, #ghc
    
    Subscribers: bgamari, thomie
    
    Differential Revision: https://phabricator.haskell.org/D930
    
    GHC Trac Issues: #10101


>---------------------------------------------------------------

4756438962a76d2dcedf63b90ec789cb054f9556
 ghc/InteractiveUI.hs                        |  9 +++------
 testsuite/tests/ghci/prog013/prog013.script |  4 ++++
 testsuite/tests/ghci/prog013/prog013.stderr | 14 +++++++++++---
 testsuite/tests/ghci/prog013/prog013.stdout |  2 ++
 4 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 0adc0cd..d3b4368 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1245,6 +1245,9 @@ editFile str =
      when (null cmd)
        $ throwGhcException (CmdLineError "editor not set, use :set editor")
      lineOpt <- liftIO $ do
+         let sameFile p1 p2 = liftA2 (==) (canonicalizePath p1) (canonicalizePath p2)
+              `catchIO` (\_ -> return False)
+
          curFileErrs <- filterM (\(f, _) -> unpackFS f `sameFile` file) errs
          return $ case curFileErrs of
              (_, line):_ -> " +" ++ show line
@@ -3222,12 +3225,6 @@ expandPathIO p =
    other ->
         return other
 
-sameFile :: FilePath -> FilePath -> IO Bool
-sameFile path1 path2 = do
-    absPath1 <- canonicalizePath path1
-    absPath2 <- canonicalizePath path2
-    return $ absPath1 == absPath2
-
 wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
 wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
 
diff --git a/testsuite/tests/ghci/prog013/prog013.script b/testsuite/tests/ghci/prog013/prog013.script
index d4b91de..f2e2343 100644
--- a/testsuite/tests/ghci/prog013/prog013.script
+++ b/testsuite/tests/ghci/prog013/prog013.script
@@ -6,3 +6,7 @@
 :e ./Bad.hs
 :l Good.hs
 :e
++
+:e foo
+:l Bad.hs
+:e bar
diff --git a/testsuite/tests/ghci/prog013/prog013.stderr b/testsuite/tests/ghci/prog013/prog013.stderr
index d8970d4..ce8827f 100644
--- a/testsuite/tests/ghci/prog013/prog013.stderr
+++ b/testsuite/tests/ghci/prog013/prog013.stderr
@@ -1,9 +1,17 @@
 
-Bad.hs:3:8:
+Bad.hs:3:8: error:
     lexical error in string/character literal at character '\n'
 
-Bad.hs:3:8:
+Bad.hs:3:8: error:
     lexical error in string/character literal at character '\n'
 
-Bad.hs:3:8:
+Bad.hs:3:8: error:
+    lexical error in string/character literal at character '\n'
+
+<interactive>:10:1: error: parse error on input ‘+’
+
+Bad.hs:3:8: error:
+    lexical error in string/character literal at character '\n'
+
+Bad.hs:3:8: error:
     lexical error in string/character literal at character '\n'
diff --git a/testsuite/tests/ghci/prog013/prog013.stdout b/testsuite/tests/ghci/prog013/prog013.stdout
index 0d621da..024fd79 100644
--- a/testsuite/tests/ghci/prog013/prog013.stdout
+++ b/testsuite/tests/ghci/prog013/prog013.stdout
@@ -2,3 +2,5 @@ Good.hs
 Bad.hs +3
 ./Bad.hs +3
 Good.hs
+foo
+bar