Skip to content

Use shorter test names in ghcide-tests #4591

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
May 22, 2025
Merged

Use shorter test names in ghcide-tests #4591

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
3c3cb15
Make the test name shorter
fendor May 13, 2025
770707f
Shorten reference test names
fendor May 13, 2025
1295b91
Merge branch 'master' into fix/shorter-test-name
fendor May 22, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
97 changes: 59 additions & 38 deletions ghcide-test/exe/CodeLensTests.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 =
Expand All @@ -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
Expand All @@ -58,51 +76,54 @@ 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
modifiedCode <- skipManyTill anyMessage (getDocumentEdit doc)
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
Expand Down
10 changes: 5 additions & 5 deletions ghcide-test/exe/ReferenceTests.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -115,39 +115,39 @@ 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)
, ("OtherModule.hs", 0, 20)
, ("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)
, ("OtherModule.hs", 0, 20)
, ("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)
, ("OtherModule.hs", 0, 48)
, ("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)
, ("OtherModule.hs", 0, 48)
, ("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)
Expand Down
Loading