Skip to content

Commit 8dd8ffc

Browse files
fendorfendor
authored
Use shorter test names in ghcide-tests (haskell#4591)
* 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. * Shorten reference test names
1 parent 6649758 commit 8dd8ffc

File tree

2 files changed

+64
-43
lines changed

2 files changed

+64
-43
lines changed

‎ghcide-test/exe/CodeLensTests.hs‎

Lines changed: 59 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ import Control.Monad.IO.Class (liftIO)
1010
import qualified Data.Aeson as A
1111
import Data.Maybe
1212
import qualified Data.Text as T
13-
import Data.Tuple.Extra
1413
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
1514
import qualified Language.LSP.Protocol.Lens as L
1615
import Language.LSP.Protocol.Types hiding
@@ -28,6 +27,25 @@ tests = testGroup "code lenses"
2827
[ addSigLensesTests
2928
]
3029

30+
data TestSpec =
31+
TestSpec
32+
{ mName :: Maybe TestName -- ^ Optional Test Name
33+
, input :: T.Text -- ^ Input
34+
, expected :: Maybe T.Text -- ^ Expected Type Sig
35+
}
36+
37+
mkT :: T.Text -> T.Text -> TestSpec
38+
mkT i e = TestSpec Nothing i (Just e)
39+
mkT' :: TestName -> T.Text -> T.Text -> TestSpec
40+
mkT' name i e = TestSpec (Just name) i (Just e)
41+
42+
noExpected :: TestSpec -> TestSpec
43+
noExpected t = t { expected = Nothing }
44+
45+
mkTestName :: TestSpec -> String
46+
mkTestName t = case mName t of
47+
Nothing -> T.unpack $ T.replace "\n" "\\n" (input t)
48+
Just name -> name
3149

3250
addSigLensesTests :: TestTree
3351
addSigLensesTests =
@@ -41,14 +59,14 @@ addSigLensesTests =
4159
, "data T1 a where"
4260
, " MkT1 :: (Show b) => a -> b -> T1 a"
4361
]
44-
before enableGHCWarnings exported (def, _) others =
45-
T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, def] <> others
46-
after' enableGHCWarnings exported (def, sig) others =
47-
T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported] <> maybe [] pure sig <> [def] <> others
62+
before enableGHCWarnings exported spec others =
63+
T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, input spec] <> others
64+
after' enableGHCWarnings exported spec others =
65+
T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported] <> maybe [] pure (expected spec) <> [input spec] <> others
4866
createConfig mode = A.object ["plugin" A..= A.object ["ghcide-type-lenses" A..= A.object ["config" A..= A.object ["mode" A..= A.String mode]]]]
49-
sigSession testName enableGHCWarnings waitForDiags mode exported def others = testWithDummyPluginEmpty testName $ do
50-
let originalCode = before enableGHCWarnings exported def others
51-
let expectedCode = after' enableGHCWarnings exported def others
67+
sigSession testName enableGHCWarnings waitForDiags mode exported spec others = testWithDummyPluginEmpty testName $ do
68+
let originalCode = before enableGHCWarnings exported spec others
69+
let expectedCode = after' enableGHCWarnings exported spec others
5270
setConfigSection "haskell" (createConfig mode)
5371
doc <- createDoc "Sigs.hs" "haskell" originalCode
5472
-- Because the diagnostics mode is really relying only on diagnostics now
@@ -58,51 +76,54 @@ addSigLensesTests =
5876
then void waitForDiagnostics
5977
else waitForProgressDone
6078
codeLenses <- getAndResolveCodeLenses doc
61-
if not $ null $ snd def
79+
if isJust $ expected spec
6280
then do
6381
liftIO $ length codeLenses == 1 @? "Expected 1 code lens, but got: " <> show codeLenses
6482
executeCommand $ fromJust $ head codeLenses ^. L.command
6583
modifiedCode <- skipManyTill anyMessage (getDocumentEdit doc)
6684
liftIO $ expectedCode @=? modifiedCode
6785
else liftIO $ null codeLenses @? "Expected no code lens, but got: " <> show codeLenses
6886
cases =
69-
[ ("abc = True", "abc :: Bool")
70-
, ("foo a b = a + b", "foo :: Num a => a -> a -> a")
71-
, ("bar a b = show $ a + b", "bar :: (Show a, Num a) => a -> a -> String")
72-
, ("(!!!) a b = a > b", "(!!!) :: Ord a => a -> a -> Bool")
73-
, ("a >>>> b = a + b", "(>>>>) :: Num a => a -> a -> a")
74-
, ("a `haha` b = a b", "haha :: (t1 -> t2) -> t1 -> t2")
75-
, ("pattern Some a = Just a", "pattern Some :: a -> Maybe a")
76-
, ("pattern Some a <- Just a", "pattern Some :: a -> Maybe a")
77-
, ("pattern Some a <- Just a\n where Some a = Just a", "pattern Some :: a -> Maybe a")
78-
, ("pattern Some a <- Just !a\n where Some !a = Just a", "pattern Some :: a -> Maybe a")
79-
, ("pattern Point{x, y} = (x, y)", "pattern Point :: a -> b -> (a, b)")
80-
, ("pattern Point{x, y} <- (x, y)", "pattern Point :: a -> b -> (a, b)")
81-
, ("pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)", "pattern Point :: a -> b -> (a, b)")
82-
, ("pattern MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a")
83-
, ("pattern MkT1' b <- MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a")
84-
, ("pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a")
85-
, ("qualifiedSigTest= C.realPart", "qualifiedSigTest :: C.Complex a -> a")
86-
, ("head = 233", "head :: Integer")
87-
, ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, String)")
88-
, ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"")
89-
, ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing")
90-
, ("typeOperatorTest = Refl", "typeOperatorTest :: forall {k} {a :: k}. a :~: a")
91-
, ("notInScopeTest = mkCharType"
92-
, if ghcVersion < GHC910
87+
[ mkT "abc = True" "abc :: Bool"
88+
, mkT "foo a b = a + b" "foo :: Num a => a -> a -> a"
89+
, mkT "bar a b = show $ a + b" "bar :: (Show a, Num a) => a -> a -> String"
90+
, mkT "(!!!) a b = a > b" "(!!!) :: Ord a => a -> a -> Bool"
91+
, mkT "a >>>> b = a + b" "(>>>>) :: Num a => a -> a -> a"
92+
, mkT "a `haha` b = a b" "haha :: (t1 -> t2) -> t1 -> t2"
93+
, mkT "pattern Some a = Just a" "pattern Some :: a -> Maybe a"
94+
, mkT "pattern Some a <- Just a" "pattern Some :: a -> Maybe a"
95+
, mkT "pattern Some a <- Just a\n where Some a = Just a" "pattern Some :: a -> Maybe a"
96+
, mkT "pattern Some a <- Just !a\n where Some !a = Just a" "pattern Some :: a -> Maybe a"
97+
, mkT "pattern Point{x, y} = (x, y)" "pattern Point :: a -> b -> (a, b)"
98+
, mkT "pattern Point{x, y} <- (x, y)" "pattern Point :: a -> b -> (a, b)"
99+
, mkT "pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)" "pattern Point :: a -> b -> (a, b)"
100+
, mkT "pattern MkT1' b = MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"
101+
, mkT "pattern MkT1' b <- MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"
102+
, 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"
103+
, mkT "qualifiedSigTest= C.realPart" "qualifiedSigTest :: C.Complex a -> a"
104+
, mkT "head = 233" "head :: Integer"
105+
, mkT "rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")" "rank2Test :: (forall a. a -> a) -> (Int, String)"
106+
, mkT "symbolKindTest = Proxy @\"qwq\"" "symbolKindTest :: Proxy \"qwq\""
107+
, mkT "promotedKindTest = Proxy @Nothing" (if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing")
108+
, mkT "typeOperatorTest = Refl" "typeOperatorTest :: forall {k} {a :: k}. a :~: a"
109+
, mkT "notInScopeTest = mkCharType"
110+
(if ghcVersion < GHC910
93111
then "notInScopeTest :: String -> Data.Data.DataType"
94112
else "notInScopeTest :: String -> GHC.Internal.Data.Data.DataType"
95113
)
96-
, ("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")
114+
115+
, mkT' "aVeryLongSignature"
116+
"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"
117+
"aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool"
97118
]
98119
in testGroup
99120
"add signature"
100-
[ testGroup "signatures are correct" [sigSession (T.unpack $ T.replace "\n" "\\n" def) False False "always" "" (def, Just sig) [] | (def, sig) <- cases]
101-
, sigSession "exported mode works" False False "exported" "xyz" ("xyz = True", Just "xyz :: Bool") (fst <$> take 3 cases)
121+
[ testGroup "signatures are correct" [sigSession (mkTestName spec) False False "always" "" spec [] | spec <- cases]
122+
, sigSession "exported mode works" False False "exported" "xyz" (mkT "xyz = True" "xyz :: Bool") (input <$> take 3 cases)
102123
, testGroup
103124
"diagnostics mode works"
104-
[ sigSession "with GHC warnings" True True "diagnostics" "" (second Just $ head cases) []
105-
, sigSession "without GHC warnings" False False "diagnostics" "" (second (const Nothing) $ head cases) []
125+
[ sigSession "with GHC warnings" True True "diagnostics" "" (head cases) []
126+
, sigSession "without GHC warnings" False False "diagnostics" "" (noExpected $ head cases) []
106127
]
107128
, testWithDummyPluginEmpty "keep stale lens" $ do
108129
let content = T.unlines

‎ghcide-test/exe/ReferenceTests.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -115,39 +115,39 @@ tests = testGroup "references"
115115
]
116116

117117
, testGroup "can get references to non FOIs"
118-
[ referenceTest "can get references to symbol defined in a module we import"
118+
[ referenceTest "references to symbol defined in a module we import"
119119
("References.hs", 22, 4)
120120
YesIncludeDeclaration
121121
[ ("References.hs", 22, 4)
122122
, ("OtherModule.hs", 0, 20)
123123
, ("OtherModule.hs", 4, 0)
124124
]
125125

126-
, referenceTest "can get references in modules that import us to symbols we define"
126+
, referenceTest "references in modules that import us to symbols we define"
127127
("OtherModule.hs", 4, 0)
128128
YesIncludeDeclaration
129129
[ ("References.hs", 22, 4)
130130
, ("OtherModule.hs", 0, 20)
131131
, ("OtherModule.hs", 4, 0)
132132
]
133133

134-
, referenceTest "can get references to symbol defined in a module we import transitively"
134+
, referenceTest "references to symbol defined in a module we import transitively"
135135
("References.hs", 24, 4)
136136
YesIncludeDeclaration
137137
[ ("References.hs", 24, 4)
138138
, ("OtherModule.hs", 0, 48)
139139
, ("OtherOtherModule.hs", 2, 0)
140140
]
141141

142-
, referenceTest "can get references in modules that import us transitively to symbols we define"
142+
, referenceTest "references in modules that transitively use symbols we define"
143143
("OtherOtherModule.hs", 2, 0)
144144
YesIncludeDeclaration
145145
[ ("References.hs", 24, 4)
146146
, ("OtherModule.hs", 0, 48)
147147
, ("OtherOtherModule.hs", 2, 0)
148148
]
149149

150-
, referenceTest "can get type references to other modules"
150+
, referenceTest "type references to other modules"
151151
("Main.hs", 12, 10)
152152
YesIncludeDeclaration
153153
[ ("Main.hs", 12, 7)

0 commit comments

Comments
 (0)