Skip to content

Commit e36dfa5

Browse files
fendorfendor
committed
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.
1 parent c3acee2 commit e36dfa5

File tree

1 file changed

+59
-38
lines changed

1 file changed

+59
-38
lines changed

‎ghcide-test/exe/CodeLensTests.hs

+59-38
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

0 commit comments

Comments
 (0)