From 3c3cb15959ea6d3ca90b9578c6640aba87411fbb Mon Sep 17 00:00:00 2001 From: fendor Date: Tue, 13 May 2025 17:16:59 +0200 Subject: [PATCH 1/2] Make the test name shorter The very long test name leads to overflows in the tasty test output reporter, causing duplicated lines and generally harder to read output, when the test output report is displayed. We refactor the test specification to optionally accept 'TestName's which can be shorter than the previous way of generating a test name. --- ghcide-test/exe/CodeLensTests.hs | 97 +++++++++++++++++++------------- 1 file changed, 59 insertions(+), 38 deletions(-) diff --git a/ghcide-test/exe/CodeLensTests.hs b/ghcide-test/exe/CodeLensTests.hs index 4ec5f3957c..fd821e37b6 100644 --- a/ghcide-test/exe/CodeLensTests.hs +++ b/ghcide-test/exe/CodeLensTests.hs @@ -10,7 +10,6 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A import Data.Maybe import qualified Data.Text as T -import Data.Tuple.Extra import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types hiding @@ -28,6 +27,25 @@ tests = testGroup "code lenses" [ addSigLensesTests ] +data TestSpec = + TestSpec + { mName :: Maybe TestName -- ^ Optional Test Name + , input :: T.Text -- ^ Input + , expected :: Maybe T.Text -- ^ Expected Type Sig + } + +mkT :: T.Text -> T.Text -> TestSpec +mkT i e = TestSpec Nothing i (Just e) +mkT' :: TestName -> T.Text -> T.Text -> TestSpec +mkT' name i e = TestSpec (Just name) i (Just e) + +noExpected :: TestSpec -> TestSpec +noExpected t = t { expected = Nothing } + +mkTestName :: TestSpec -> String +mkTestName t = case mName t of + Nothing -> T.unpack $ T.replace "\n" "\\n" (input t) + Just name -> name addSigLensesTests :: TestTree addSigLensesTests = @@ -41,14 +59,14 @@ addSigLensesTests = , "data T1 a where" , " MkT1 :: (Show b) => a -> b -> T1 a" ] - before enableGHCWarnings exported (def, _) others = - T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, def] <> others - after' enableGHCWarnings exported (def, sig) others = - T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported] <> maybe [] pure sig <> [def] <> others + before enableGHCWarnings exported spec others = + T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, input spec] <> others + after' enableGHCWarnings exported spec others = + T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported] <> maybe [] pure (expected spec) <> [input spec] <> others createConfig mode = A.object ["plugin" A..= A.object ["ghcide-type-lenses" A..= A.object ["config" A..= A.object ["mode" A..= A.String mode]]]] - sigSession testName enableGHCWarnings waitForDiags mode exported def others = testWithDummyPluginEmpty testName $ do - let originalCode = before enableGHCWarnings exported def others - let expectedCode = after' enableGHCWarnings exported def others + sigSession testName enableGHCWarnings waitForDiags mode exported spec others = testWithDummyPluginEmpty testName $ do + let originalCode = before enableGHCWarnings exported spec others + let expectedCode = after' enableGHCWarnings exported spec others setConfigSection "haskell" (createConfig mode) doc <- createDoc "Sigs.hs" "haskell" originalCode -- Because the diagnostics mode is really relying only on diagnostics now @@ -58,7 +76,7 @@ addSigLensesTests = then void waitForDiagnostics else waitForProgressDone codeLenses <- getAndResolveCodeLenses doc - if not $ null $ snd def + if isJust $ expected spec then do liftIO $ length codeLenses == 1 @? "Expected 1 code lens, but got: " <> show codeLenses executeCommand $ fromJust $ head codeLenses ^. L.command @@ -66,43 +84,46 @@ addSigLensesTests = liftIO $ expectedCode @=? modifiedCode else liftIO $ null codeLenses @? "Expected no code lens, but got: " <> show codeLenses cases = - [ ("abc = True", "abc :: Bool") - , ("foo a b = a + b", "foo :: Num a => a -> a -> a") - , ("bar a b = show $ a + b", "bar :: (Show a, Num a) => a -> a -> String") - , ("(!!!) a b = a > b", "(!!!) :: Ord a => a -> a -> Bool") - , ("a >>>> b = a + b", "(>>>>) :: Num a => a -> a -> a") - , ("a `haha` b = a b", "haha :: (t1 -> t2) -> t1 -> t2") - , ("pattern Some a = Just a", "pattern Some :: a -> Maybe a") - , ("pattern Some a <- Just a", "pattern Some :: a -> Maybe a") - , ("pattern Some a <- Just a\n where Some a = Just a", "pattern Some :: a -> Maybe a") - , ("pattern Some a <- Just !a\n where Some !a = Just a", "pattern Some :: a -> Maybe a") - , ("pattern Point{x, y} = (x, y)", "pattern Point :: a -> b -> (a, b)") - , ("pattern Point{x, y} <- (x, y)", "pattern Point :: a -> b -> (a, b)") - , ("pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)", "pattern Point :: a -> b -> (a, b)") - , ("pattern MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("pattern MkT1' b <- MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("qualifiedSigTest= C.realPart", "qualifiedSigTest :: C.Complex a -> a") - , ("head = 233", "head :: Integer") - , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, String)") - , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"") - , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") - , ("typeOperatorTest = Refl", "typeOperatorTest :: forall {k} {a :: k}. a :~: a") - , ("notInScopeTest = mkCharType" - , if ghcVersion < GHC910 + [ mkT "abc = True" "abc :: Bool" + , mkT "foo a b = a + b" "foo :: Num a => a -> a -> a" + , mkT "bar a b = show $ a + b" "bar :: (Show a, Num a) => a -> a -> String" + , mkT "(!!!) a b = a > b" "(!!!) :: Ord a => a -> a -> Bool" + , mkT "a >>>> b = a + b" "(>>>>) :: Num a => a -> a -> a" + , mkT "a `haha` b = a b" "haha :: (t1 -> t2) -> t1 -> t2" + , mkT "pattern Some a = Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Some a <- Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Some a <- Just a\n where Some a = Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Some a <- Just !a\n where Some !a = Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Point{x, y} = (x, y)" "pattern Point :: a -> b -> (a, b)" + , mkT "pattern Point{x, y} <- (x, y)" "pattern Point :: a -> b -> (a, b)" + , mkT "pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)" "pattern Point :: a -> b -> (a, b)" + , mkT "pattern MkT1' b = MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , mkT "pattern MkT1' b <- MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , mkT "pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , mkT "qualifiedSigTest= C.realPart" "qualifiedSigTest :: C.Complex a -> a" + , mkT "head = 233" "head :: Integer" + , mkT "rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")" "rank2Test :: (forall a. a -> a) -> (Int, String)" + , mkT "symbolKindTest = Proxy @\"qwq\"" "symbolKindTest :: Proxy \"qwq\"" + , mkT "promotedKindTest = Proxy @Nothing" (if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") + , mkT "typeOperatorTest = Refl" "typeOperatorTest :: forall {k} {a :: k}. a :~: a" + , mkT "notInScopeTest = mkCharType" + (if ghcVersion < GHC910 then "notInScopeTest :: String -> Data.Data.DataType" else "notInScopeTest :: String -> GHC.Internal.Data.Data.DataType" ) - , ("aVeryLongSignature a b c d e f g h i j k l m n = a && b && c && d && e && f && g && h && i && j && k && l && m && n", "aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool") + + , mkT' "aVeryLongSignature" + "aVeryLongSignature a b c d e f g h i j k l m n = a && b && c && d && e && f && g && h && i && j && k && l && m && n" + "aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool" ] in testGroup "add signature" - [ testGroup "signatures are correct" [sigSession (T.unpack $ T.replace "\n" "\\n" def) False False "always" "" (def, Just sig) [] | (def, sig) <- cases] - , sigSession "exported mode works" False False "exported" "xyz" ("xyz = True", Just "xyz :: Bool") (fst <$> take 3 cases) + [ testGroup "signatures are correct" [sigSession (mkTestName spec) False False "always" "" spec [] | spec <- cases] + , sigSession "exported mode works" False False "exported" "xyz" (mkT "xyz = True" "xyz :: Bool") (input <$> take 3 cases) , testGroup "diagnostics mode works" - [ sigSession "with GHC warnings" True True "diagnostics" "" (second Just $ head cases) [] - , sigSession "without GHC warnings" False False "diagnostics" "" (second (const Nothing) $ head cases) [] + [ sigSession "with GHC warnings" True True "diagnostics" "" (head cases) [] + , sigSession "without GHC warnings" False False "diagnostics" "" (noExpected $ head cases) [] ] , testWithDummyPluginEmpty "keep stale lens" $ do let content = T.unlines From 770707f4d5675562c53e635d4d3f2a880562f5e6 Mon Sep 17 00:00:00 2001 From: fendor Date: Tue, 13 May 2025 17:41:38 +0200 Subject: [PATCH 2/2] Shorten reference test names --- ghcide-test/exe/ReferenceTests.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ghcide-test/exe/ReferenceTests.hs b/ghcide-test/exe/ReferenceTests.hs index 50c263c4fc..cdbf8e472d 100644 --- a/ghcide-test/exe/ReferenceTests.hs +++ b/ghcide-test/exe/ReferenceTests.hs @@ -115,7 +115,7 @@ tests = testGroup "references" ] , testGroup "can get references to non FOIs" - [ referenceTest "can get references to symbol defined in a module we import" + [ referenceTest "references to symbol defined in a module we import" ("References.hs", 22, 4) YesIncludeDeclaration [ ("References.hs", 22, 4) @@ -123,7 +123,7 @@ tests = testGroup "references" , ("OtherModule.hs", 4, 0) ] - , referenceTest "can get references in modules that import us to symbols we define" + , referenceTest "references in modules that import us to symbols we define" ("OtherModule.hs", 4, 0) YesIncludeDeclaration [ ("References.hs", 22, 4) @@ -131,7 +131,7 @@ tests = testGroup "references" , ("OtherModule.hs", 4, 0) ] - , referenceTest "can get references to symbol defined in a module we import transitively" + , referenceTest "references to symbol defined in a module we import transitively" ("References.hs", 24, 4) YesIncludeDeclaration [ ("References.hs", 24, 4) @@ -139,7 +139,7 @@ tests = testGroup "references" , ("OtherOtherModule.hs", 2, 0) ] - , referenceTest "can get references in modules that import us transitively to symbols we define" + , referenceTest "references in modules that transitively use symbols we define" ("OtherOtherModule.hs", 2, 0) YesIncludeDeclaration [ ("References.hs", 24, 4) @@ -147,7 +147,7 @@ tests = testGroup "references" , ("OtherOtherModule.hs", 2, 0) ] - , referenceTest "can get type references to other modules" + , referenceTest "type references to other modules" ("Main.hs", 12, 10) YesIncludeDeclaration [ ("Main.hs", 12, 7)