Tue Nov 28 11:38:20 UTC 2017

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

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/c2a4125e3a5158078d8c172a840f7292dcf3ab28

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

commit c2a4125e3a5158078d8c172a840f7292dcf3ab28
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Tue Aug 18 20:32:12 2015 +0200

    Fix path handling in test runner.


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

c2a4125e3a5158078d8c172a840f7292dcf3ab28
 haddock-test/src/Test/Haddock/Config.hs | 25 ++++++++++---------------
 1 file changed, 10 insertions(+), 15 deletions(-)

diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 15a5382..1b89e27 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -238,34 +238,29 @@ defaultDiffTool =
 
 processFileArgs :: DirConfig -> [String] -> IO [TestPackage]
 processFileArgs dcfg [] =
-    processFileArgs dcfg . filter isValidEntry =<< getDirectoryContents srcDir
+    processFileArgs' dcfg . filter isValidEntry =<< getDirectoryContents srcDir
   where
-    isValidEntry entry = entry /= "." && entry /= ".."
+    isValidEntry entry
+        | hasExtension entry = takeExtension entry `elem` [".hs", ".lhs"]
+        | otherwise = entry /= "." && entry /= ".."
     srcDir = dcfgSrcDir dcfg
 processFileArgs dcfg args = processFileArgs' dcfg args
 
 
 processFileArgs' :: DirConfig -> [String] -> IO [TestPackage]
 processFileArgs' dcfg args = do
-    (mdls, dirs) <- partitionM doesDirectoryExist' args
+    (dirs, mdls) <- partitionM doesDirectoryExist' . map takeBaseName $ args
     rootPkg <- pure $ TestPackage
         { tpkgName = ""
-        , tpkgFiles = map (processFileArg dcfg) mdls
+        , tpkgFiles = map (srcDir </>) mdls
         }
     otherPkgs <- forM dirs $ \dir -> do
-        files <- getDirectoryContents dir
+        files <- getDirectoryContents (srcDir </> dir)
         pure $ TestPackage
             { tpkgName = dir
-            , tpkgFiles = map ((dcfgSrcDir dcfg </> dir) </>) files
+            , tpkgFiles = map ((srcDir </> dir) </>) files
             }
     pure $ rootPkg:otherPkgs
   where
-    doesDirectoryExist' path = doesDirectoryExist (dcfgSrcDir dcfg </> path)
-
-
-processFileArg :: DirConfig -> String -> FilePath
-processFileArg dcfg arg
-    | isSourceFile arg = arg
-    | otherwise = dcfgSrcDir dcfg </> arg </> ".hs"
-  where
-    isSourceFile path = takeExtension path `elem` [".hs", ".lhs"]
+    doesDirectoryExist' path = doesDirectoryExist (srcDir </> path)
+    srcDir = dcfgSrcDir dcfg

