From a79118836602ca59b4e8d1c9351b0f67b44f2b2b Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 1 May 2024 18:32:26 +0800 Subject: [PATCH 1/4] use canonicalizePath path in tmp dir in hls-test-utils --- hls-test-utils/src/Test/Hls.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 83dd8ed00b..9ebdb83351 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -109,7 +109,7 @@ import Prelude hiding (log) import System.Directory (createDirectoryIfMissing, getCurrentDirectory, getTemporaryDirectory, - setCurrentDirectory) + setCurrentDirectory, canonicalizePath) import System.Environment (lookupEnv, setEnv) import System.FilePath import System.IO.Extra (newTempDirWithin) @@ -451,7 +451,8 @@ runSessionWithServerInTmpDirCont plugins conf sessConf caps tree act = withLock logWith recorder Debug LogCleanup pure a - runTestInDir $ \tmpDir -> do + runTestInDir $ \tmpDir' -> do + tmpDir <- canonicalizePath tmpDir' logWith recorder Info $ LogTestDir tmpDir fs <- FS.materialiseVFT tmpDir tree runSessionWithServer' plugins conf sessConf caps tmpDir (act fs) From e2638b5d26a36d08b6ec573312f367f15c3a5d83 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 1 May 2024 18:35:55 +0800 Subject: [PATCH 2/4] migrate IfaceTests to hls-test-utils --- ghcide/test/exe/Config.hs | 8 +++++++ ghcide/test/exe/IfaceTests.hs | 29 ++++++++++++----------- hls-test-utils/src/Test/Hls/FileSystem.hs | 3 +-- 3 files changed, 24 insertions(+), 16 deletions(-) diff --git a/ghcide/test/exe/Config.hs b/ghcide/test/exe/Config.hs index 4ec7901bf3..31f4dc05e0 100644 --- a/ghcide/test/exe/Config.hs +++ b/ghcide/test/exe/Config.hs @@ -40,5 +40,13 @@ testWithDummyPluginEmpty caseName = testWithDummyPlugin caseName $ mkIdeTestFs [ testWithDummyPluginEmpty' :: String -> (FileSystem -> Session ()) -> TestTree testWithDummyPluginEmpty' caseName = testWithDummyPlugin' caseName $ mkIdeTestFs [] +runWithExtraFiles :: String -> (FileSystem -> Session a) -> IO a +runWithExtraFiles dirName action = do + let vfs = mkIdeTestFs [FS.copyDir dirName] + runWithDummyPlugin' vfs action + +testWithExtraFiles :: String -> String -> (FileSystem -> Session ()) -> TestTree +testWithExtraFiles testName dirName action = testCase testName $ runWithExtraFiles dirName action + pattern R :: UInt -> UInt -> UInt -> UInt -> Range pattern R x y x' y' = Range (Position x y) (Position x' y') diff --git a/ghcide/test/exe/IfaceTests.hs b/ghcide/test/exe/IfaceTests.hs index 7731100a3b..4d8d156f66 100644 --- a/ghcide/test/exe/IfaceTests.hs +++ b/ghcide/test/exe/IfaceTests.hs @@ -19,7 +19,8 @@ import System.FilePath import System.IO.Extra hiding (withTempDir) import Test.Tasty import Test.Tasty.HUnit -import TestUtils +import Config +import Test.Hls.FileSystem (toAbsFp) tests :: TestTree tests = testGroup "Interface loading tests" @@ -33,10 +34,10 @@ tests = testGroup "Interface loading tests" -- | test that TH reevaluates across interfaces ifaceTHTest :: TestTree -ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do - let aPath = dir "THA.hs" - bPath = dir "THB.hs" - cPath = dir "THC.hs" +ifaceTHTest = testWithExtraFiles "iface-th-test" "TH" $ \dir -> do + let aPath = dir `toAbsFp` "THA.hs" + bPath = dir `toAbsFp` "THB.hs" + cPath = dir `toAbsFp` "THC.hs" aSource <- liftIO $ readFileUtf8 aPath -- [TH] a :: () _bSource <- liftIO $ readFileUtf8 bPath -- a :: () @@ -55,10 +56,10 @@ ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do closeDoc cdoc ifaceErrorTest :: TestTree -ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \dir -> do +ifaceErrorTest = testWithExtraFiles "iface-error-test-1" "recomp" $ \dir -> do configureCheckProject True - let bPath = dir "B.hs" - pPath = dir "P.hs" + let bPath = dir `toAbsFp` "B.hs" + pPath = dir `toAbsFp` "P.hs" bSource <- liftIO $ readFileUtf8 bPath -- y :: Int pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int @@ -104,9 +105,9 @@ ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \d expectNoMoreDiagnostics 2 ifaceErrorTest2 :: TestTree -ifaceErrorTest2 = testCase "iface-error-test-2" $ runWithExtraFiles "recomp" $ \dir -> do - let bPath = dir "B.hs" - pPath = dir "P.hs" +ifaceErrorTest2 = testWithExtraFiles "iface-error-test-2" "recomp" $ \dir -> do + let bPath = dir `toAbsFp` "B.hs" + pPath = dir `toAbsFp` "P.hs" bSource <- liftIO $ readFileUtf8 bPath -- y :: Int pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int @@ -138,9 +139,9 @@ ifaceErrorTest2 = testCase "iface-error-test-2" $ runWithExtraFiles "recomp" $ \ expectNoMoreDiagnostics 2 ifaceErrorTest3 :: TestTree -ifaceErrorTest3 = testCase "iface-error-test-3" $ runWithExtraFiles "recomp" $ \dir -> do - let bPath = dir "B.hs" - pPath = dir "P.hs" +ifaceErrorTest3 = testWithExtraFiles "iface-error-test-3" "recomp" $ \dir -> do + let bPath = dir `toAbsFp` "B.hs" + pPath = dir `toAbsFp` "P.hs" bSource <- liftIO $ readFileUtf8 bPath -- y :: Int pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int diff --git a/hls-test-utils/src/Test/Hls/FileSystem.hs b/hls-test-utils/src/Test/Hls/FileSystem.hs index 221fb7c23b..1416564e38 100644 --- a/hls-test-utils/src/Test/Hls/FileSystem.hs +++ b/hls-test-utils/src/Test/Hls/FileSystem.hs @@ -128,8 +128,7 @@ materialise rootDir' fileTree testDataDir' = do -- -- File references in 'virtualFileTree' are resolved relative to the @vftOriginalRoot@. materialiseVFT :: FilePath -> VirtualFileTree -> IO FileSystem -materialiseVFT root fs = - materialise root (vftTree fs) (vftOriginalRoot fs) +materialiseVFT root fs = materialise root (vftTree fs) (vftOriginalRoot fs) -- ---------------------------------------------------------------------------- -- Test definition helpers From b20e433a8330e8ac702bde127db149747ba3ddd3 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 1 May 2024 18:41:00 +0800 Subject: [PATCH 3/4] sylish --- ghcide/test/exe/IfaceTests.hs | 4 ++-- hls-test-utils/src/Test/Hls.hs | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/ghcide/test/exe/IfaceTests.hs b/ghcide/test/exe/IfaceTests.hs index 4d8d156f66..24d5115f3a 100644 --- a/ghcide/test/exe/IfaceTests.hs +++ b/ghcide/test/exe/IfaceTests.hs @@ -1,5 +1,6 @@ module IfaceTests (tests) where +import Config import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Development.IDE.GHC.Util @@ -17,10 +18,9 @@ import Language.LSP.Test import System.Directory import System.FilePath import System.IO.Extra hiding (withTempDir) +import Test.Hls.FileSystem (toAbsFp) import Test.Tasty import Test.Tasty.HUnit -import Config -import Test.Hls.FileSystem (toAbsFp) tests :: TestTree tests = testGroup "Interface loading tests" diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 9ebdb83351..81b77506b3 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -106,10 +106,11 @@ import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types hiding (Null) import Language.LSP.Test import Prelude hiding (log) -import System.Directory (createDirectoryIfMissing, +import System.Directory (canonicalizePath, + createDirectoryIfMissing, getCurrentDirectory, getTemporaryDirectory, - setCurrentDirectory, canonicalizePath) + setCurrentDirectory) import System.Environment (lookupEnv, setEnv) import System.FilePath import System.IO.Extra (newTempDirWithin) From 89d0ee198c0e2efd96ef28a52f5a37f83157cb4a Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 2 May 2024 18:23:33 +0800 Subject: [PATCH 4/4] add comment --- hls-test-utils/src/Test/Hls.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 81b77506b3..68efc4a47d 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -453,6 +453,8 @@ runSessionWithServerInTmpDirCont plugins conf sessConf caps tree act = withLock pure a runTestInDir $ \tmpDir' -> do + -- we canonicalize the path, so that we do not need to do + -- cannibalization during the test when we compare two paths tmpDir <- canonicalizePath tmpDir' logWith recorder Info $ LogTestDir tmpDir fs <- FS.materialiseVFT tmpDir tree