From 9dc0281413eb5cc92aa4d5d912691646ca142fa5 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sat, 27 Apr 2024 17:16:15 +0800 Subject: [PATCH 1/4] wip trace flaky --- ghcide/test/exe/DependentFileTest.hs | 17 ++++++++++++----- ghcide/test/src/Development/IDE/Test.hs | 7 ++++++- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/ghcide/test/exe/DependentFileTest.hs b/ghcide/test/exe/DependentFileTest.hs index d5fff45bea..ab223454c2 100644 --- a/ghcide/test/exe/DependentFileTest.hs +++ b/ghcide/test/exe/DependentFileTest.hs @@ -4,9 +4,11 @@ module DependentFileTest (tests) where +import Config import Control.Monad.IO.Class (liftIO) import Data.Row import qualified Data.Text as T +import Debug.Trace (traceShowM) import Development.IDE.Test (expectDiagnostics) import Development.IDE.Types.Location import Language.LSP.Protocol.Message @@ -16,19 +18,20 @@ import Language.LSP.Protocol.Types hiding SemanticTokensEdit (..), mkRange) import Language.LSP.Test -import System.FilePath +import Test.Hls.FileSystem (FileSystem, toAbsFp) import Test.Tasty -import TestUtils tests :: TestTree tests = testGroup "addDependentFile" - [testGroup "file-changed" [testSession' "test" test] + [testGroup "file-changed" [testWithDummyPlugin' "test" (mkIdeTestFs []) test] ] where + test :: FileSystem -> Session () test dir = do -- If the file contains B then no type error -- otherwise type error - let depFilePath = dir "dep-file.txt" + traceShowM "beginning test" + let depFilePath = toAbsFp dir "dep-file.txt" liftIO $ writeFile depFilePath "A" let fooContent = T.unlines [ "{-# LANGUAGE TemplateHaskell #-}" @@ -40,11 +43,14 @@ tests = testGroup "addDependentFile" , " f <- qRunIO (readFile \"dep-file.txt\")" , " if f == \"B\" then [| 1 |] else lift f)" ] + traceShowM "before create Foo.hs" let bazContent = T.unlines ["module Baz where", "import Foo ()"] - _ <- createDoc "Foo.hs" "haskell" fooContent + _fooDoc <- createDoc "Foo.hs" "haskell" fooContent + traceShowM "created foo" doc <- createDoc "Baz.hs" "haskell" bazContent expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type")])] + traceShowM "after expectDiagnostics" -- Now modify the dependent file liftIO $ writeFile depFilePath "B" sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams @@ -55,4 +61,5 @@ tests = testGroup "addDependentFile" .+ #rangeLength .== Nothing .+ #text .== "f = ()" changeDoc doc [change] + traceShowM "before last expectDiagnostics" expectDiagnostics [("Foo.hs", [])] diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index adaa5801c0..632a495986 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -45,6 +45,7 @@ import Data.Maybe (fromJust) import Data.Proxy import Data.Text (Text) import qualified Data.Text as T +import Debug.Trace (traceShowM) import Development.IDE.Plugin.Test (TestRequest (..), WaitForIdeRuleResult, ideResultSuccess) @@ -124,7 +125,9 @@ expectDiagnosticsWithTags :: HasCallStack => [(String, [(DiagnosticSeverity, Cur expectDiagnosticsWithTags expected = do let f = getDocUri >=> liftIO . canonicalizeUri >=> pure . toNormalizedUri next = unwrapDiagnostic <$> skipManyTill anyMessage diagnostic + traceShowM $ "Trace: " <> show expected expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) f expected + traceShowM $ "Trace: " <> show expected' expectDiagnosticsWithTags' next expected' expectDiagnosticsWithTags' :: @@ -134,18 +137,20 @@ expectDiagnosticsWithTags' :: m () expectDiagnosticsWithTags' next m | null m = do (_,actual) <- next + traceShowM $ "Trace: " <> show actual case actual of [] -> return () _ -> liftIO $ assertFailure $ "Got unexpected diagnostics:" <> show actual - +-- get the next diagnostic message and check and remove the expected diagnostics from the map expectDiagnosticsWithTags' next expected = go expected where go m | Map.null m = pure () | otherwise = do (fileUri, actual) <- next + traceShowM $ "Trace: " <> show actual canonUri <- liftIO $ toNormalizedUri <$> canonicalizeUri fileUri case Map.lookup canonUri m of Nothing -> do From 030a7fe8d15a2e62d3498842cddb6304e4e55cd1 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 22:13:41 +0800 Subject: [PATCH 2/4] clena up trace --- ghcide/test/exe/DependentFileTest.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/ghcide/test/exe/DependentFileTest.hs b/ghcide/test/exe/DependentFileTest.hs index ab223454c2..589c764459 100644 --- a/ghcide/test/exe/DependentFileTest.hs +++ b/ghcide/test/exe/DependentFileTest.hs @@ -8,7 +8,6 @@ import Config import Control.Monad.IO.Class (liftIO) import Data.Row import qualified Data.Text as T -import Debug.Trace (traceShowM) import Development.IDE.Test (expectDiagnostics) import Development.IDE.Types.Location import Language.LSP.Protocol.Message @@ -30,7 +29,6 @@ tests = testGroup "addDependentFile" test dir = do -- If the file contains B then no type error -- otherwise type error - traceShowM "beginning test" let depFilePath = toAbsFp dir "dep-file.txt" liftIO $ writeFile depFilePath "A" let fooContent = T.unlines @@ -43,14 +41,11 @@ tests = testGroup "addDependentFile" , " f <- qRunIO (readFile \"dep-file.txt\")" , " if f == \"B\" then [| 1 |] else lift f)" ] - traceShowM "before create Foo.hs" let bazContent = T.unlines ["module Baz where", "import Foo ()"] _fooDoc <- createDoc "Foo.hs" "haskell" fooContent - traceShowM "created foo" doc <- createDoc "Baz.hs" "haskell" bazContent expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type")])] - traceShowM "after expectDiagnostics" -- Now modify the dependent file liftIO $ writeFile depFilePath "B" sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams @@ -61,5 +56,4 @@ tests = testGroup "addDependentFile" .+ #rangeLength .== Nothing .+ #text .== "f = ()" changeDoc doc [change] - traceShowM "before last expectDiagnostics" expectDiagnostics [("Foo.hs", [])] From 6027a8783cae95c1856daaea93603395aa9b2768 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 23:28:16 +0800 Subject: [PATCH 3/4] cleanup --- ghcide/test/src/Development/IDE/Test.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index 632a495986..eef67cbd63 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -45,7 +45,6 @@ import Data.Maybe (fromJust) import Data.Proxy import Data.Text (Text) import qualified Data.Text as T -import Debug.Trace (traceShowM) import Development.IDE.Plugin.Test (TestRequest (..), WaitForIdeRuleResult, ideResultSuccess) @@ -125,9 +124,7 @@ expectDiagnosticsWithTags :: HasCallStack => [(String, [(DiagnosticSeverity, Cur expectDiagnosticsWithTags expected = do let f = getDocUri >=> liftIO . canonicalizeUri >=> pure . toNormalizedUri next = unwrapDiagnostic <$> skipManyTill anyMessage diagnostic - traceShowM $ "Trace: " <> show expected expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) f expected - traceShowM $ "Trace: " <> show expected' expectDiagnosticsWithTags' next expected' expectDiagnosticsWithTags' :: @@ -137,7 +134,6 @@ expectDiagnosticsWithTags' :: m () expectDiagnosticsWithTags' next m | null m = do (_,actual) <- next - traceShowM $ "Trace: " <> show actual case actual of [] -> return () @@ -150,7 +146,6 @@ expectDiagnosticsWithTags' next expected = go expected | Map.null m = pure () | otherwise = do (fileUri, actual) <- next - traceShowM $ "Trace: " <> show actual canonUri <- liftIO $ toNormalizedUri <$> canonicalizeUri fileUri case Map.lookup canonUri m of Nothing -> do From 5ca785a0046932be30c6e8fc785197c8beb41478 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 28 Apr 2024 23:29:06 +0800 Subject: [PATCH 4/4] cleanup --- ghcide/test/src/Development/IDE/Test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index eef67cbd63..adaa5801c0 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -139,7 +139,7 @@ expectDiagnosticsWithTags' next m | null m = do return () _ -> liftIO $ assertFailure $ "Got unexpected diagnostics:" <> show actual --- get the next diagnostic message and check and remove the expected diagnostics from the map + expectDiagnosticsWithTags' next expected = go expected where go m