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

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
+64 −43
Open

Use shorter test names in ghcide-tests #4591

Changes from all commits
Commits
Show all changes
2 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
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
Original file line number Diff line number Diff line change
@@ -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,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
10 changes: 5 additions & 5 deletions ghcide-test/exe/ReferenceTests.hs
View file
Original file line number Diff line number Diff line change
@@ -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)

Unchanged files with check annotations Beta

View file
exe/Wrapper.hs
{-# LANGUAGE CPP #-}

Check warning on line 1 in exe/Wrapper.hs

GitHub Actions / Hlint check run 

Warning in module Main: Use module export list ▫︎ Found: "module Main where" ▫︎ Perhaps: "module Main (\n module Main\n ) where" ▫︎ Note: an explicit list is usually better
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
View file
ghcide/session-loader/Development/IDE/Session.hs
[] -> error $ "GHC version could not be parsed: " <> version
((runTime, _):_)
| compileTime == runTime -> do
atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))

Check warning on line 630 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run 

Warning in loadSessionWithOptions in module Development.IDE.Session: Use atomicModifyIORef'_ ▫︎ Found: "atomicModifyIORef' cradle_files (\\ xs -> (cfp : xs, ()))" ▫︎ Perhaps: "atomicModifyIORef'_ cradle_files ((:) cfp)"
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
| otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
-- Failure case, either a cradle error or the none cradle
x <- map errMsgDiagnostic closure_errs
DriverHomePackagesNotClosed us <- pure x
pure us
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units

Check warning on line 901 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run 

Suggestion in newComponentCache in module Development.IDE.Session: Redundant bracket ▫︎ Found: "(homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units" ▫︎ Perhaps: "homeUnitId_ (componentDynFlags ci) `OS.member` bad_units"
-- Whenever we spin up a session on Linux, dynamically load libm.so.6
-- in. We need this in case the binary is statically linked, in which
-- case the interactive session will fail when trying to load
View file
ghcide/session-loader/Development/IDE/Session/Diagnostics.hs
{-# LANGUAGE DeriveAnyClass #-}

Check warning on line 1 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run 

Warning in module Development.IDE.Session.Diagnostics: Use module export list ▫︎ Found: "module Development.IDE.Session.Diagnostics where" ▫︎ Perhaps: "module Development.IDE.Session.Diagnostics (\n module Development.IDE.Session.Diagnostics\n ) where" ▫︎ Note: an explicit list is usually better
module Development.IDE.Session.Diagnostics where
import Control.Applicative
surround start s end = do
guard (listToMaybe s == Just start)
guard (listToMaybe (reverse s) == Just end)
pure $ drop 1 $ take (length s - 1) s

Check warning on line 92 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run 

Warning in parseMultiCradleErr in module Development.IDE.Session.Diagnostics: Use drop1 ▫︎ Found: "drop 1" ▫︎ Perhaps: "drop1"
multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage e =
View file
ghcide/src/Development/IDE/Core/PluginUtils.hs
Just fileDiags -> do
pure $ Just $ filter diagRangeOverlaps fileDiags
where
diagRangeOverlaps = \fileDiag ->

Check warning on line 219 in ghcide/src/Development/IDE/Core/PluginUtils.hs

GitHub Actions / Hlint check run 

Warning in activeDiagnosticsInRangeMT in module Development.IDE.Core.PluginUtils: Redundant lambda ▫︎ Found: "diagRangeOverlaps\n = \\ fileDiag\n -> rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)" ▫︎ Perhaps: "diagRangeOverlaps fileDiag\n = rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)"
rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)
-- | Just like 'activeDiagnosticsInRangeMT'. See the docs of 'activeDiagnosticsInRangeMT' for details.
View file
ghcide/src/Development/IDE/Core/Rules.hs
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 803 in ghcide/src/Development/IDE/Core/Rules.hs

GitHub Actions / Hlint check run 

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, get_module_graph = useNoFile_ GetModuleGraph
, regenerate = regenerateHiFile session f ms
}
-- thus bump its modification time, forcing this rule to be rerun every time.
exists <- liftIO $ doesFileExist obj_file
mobj_time <- liftIO $
if exists

Check warning on line 1096 in ghcide/src/Development/IDE/Core/Rules.hs

GitHub Actions / Hlint check run 

Warning in getLinkableRule in module Development.IDE.Core.Rules: Use whenMaybe ▫︎ Found: "if exists then Just <$> getModTime obj_file else pure Nothing" ▫︎ Perhaps: "whenMaybe exists (getModTime obj_file)"
then Just <$> getModTime obj_file
else pure Nothing
case mobj_time of
View file
ghcide/src/Development/IDE/GHC/Compat/Core.hs
moduleUnit, toUnitId)
import qualified GHC.Unit.Module as Module
import GHC.Unit.State (ModuleOrigin (..))
import GHC.Utils.Error (Severity (..), emptyMessages)

Check warning on line 491 in ghcide/src/Development/IDE/GHC/Compat/Core.hs

GitHub Actions / Hlint check run 

Warning in module Development.IDE.GHC.Compat.Core: Use fewer imports ▫︎ Found: "import GHC.Utils.Error ( Severity(..), emptyMessages )\nimport GHC.Utils.Error ( mkPlainErrorMsgEnvelope )\n" ▫︎ Perhaps: "import GHC.Utils.Error\n ( Severity(..), emptyMessages, mkPlainErrorMsgEnvelope )\n"
import GHC.Utils.Panic hiding (try)

Check warning on line 492 in ghcide/src/Development/IDE/GHC/Compat/Core.hs

GitHub Actions / Hlint check run 

Warning in module Development.IDE.GHC.Compat.Core: Use fewer imports ▫︎ Found: "import GHC.Utils.Panic hiding ( try )\nimport GHC.Utils.Panic\n" ▫︎ Perhaps: "import GHC.Utils.Panic\n"
import qualified GHC.Utils.Panic.Plain as Plain