Hadrian: Make makeRelativeNoSysLink total
authorMatthew Pickering <matthewtpickering@gmail.com>
Sun, 10 Mar 2019 17:36:32 +0000 (17:36 +0000)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Tue, 12 Mar 2019 13:04:52 +0000 (09:04 -0400)
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.

hadrian/src/Hadrian/Utilities.hs

index e5fc712..42a6fff 100644 (file)
@@ -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")