[commit: ghc] master: Hadrian: Make makeRelativeNoSysLink total (705fa21)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/705fa21d674a5a799712346e01033db98b16e71d/ghc

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

commit 705fa21d674a5a799712346e01033db98b16e71d
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date:   Sun Mar 10 17:36:32 2019 +0000

    Hadrian: Make makeRelativeNoSysLink total
    
    makeRelativeNoSysLink would previously crash for no reason if the first
    argument as `./` due to the call to `head`. This refactoring keeps the
    behaviour the same but doesn't crash in this corner case.


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

705fa21d674a5a799712346e01033db98b16e71d
 hadrian/src/Hadrian/Utilities.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index e5fc712..42a6fff 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -166,14 +166,15 @@ makeRelativeNoSysLink a b
         -- Use removePrefix to get the relative paths relative to a new
         -- base directory as high in the directory tree as possible.
         (baseToA, baseToB) = removePrefix aRelSplit bRelSplit
-        aToBase = if isDirUp (head baseToA)
-                    -- if baseToA contains any '..' then there is no way to get
-                    -- a path from a to the base directory.
-                    -- E.g. if   baseToA == "../u/v"
-                    --      then aToBase == "../../<UnknownDir>"
-                    then error $ "Impossible to find relatieve path from "
+        aToBase = case baseToA of
+                   (p: _) | isDirUp p ->
+                      -- if baseToA contains any '..' then there is no way to get
+                      -- a path from a to the base directory.
+                      -- E.g. if   baseToA == "../u/v"
+                      --      then aToBase == "../../<UnknownDir>"
+                      error $ "Impossible to find relatieve path from "
                                     ++ a ++ " to " ++ b
-                    else".." <$ baseToA
+                   _ -> ".." <$ baseToA
         aToB = aToBase ++ baseToB
 
         -- removePrefix "pre123" "prefix456" == ("123", "fix456")