From fb1a943670f7615e06e0c0a9fe6ae59fb22c3707 Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 15 Nov 2023 12:30:44 +0100 Subject: [PATCH] Prefer hls-test-utils functions over code duplication --- plugins/hls-refactor-plugin/test/Main.hs | 50 ++++-------------------- 1 file changed, 7 insertions(+), 43 deletions(-) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index e7975e21fa..e9ab5ebf71 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -43,7 +43,6 @@ import Language.LSP.Protocol.Types hiding import Language.LSP.Test import System.Directory import System.FilePath -import System.Info.Extra (isMac, isWindows) import qualified System.IO.Extra import System.IO.Extra hiding (withTempDir) import System.Time.Extra @@ -1315,7 +1314,7 @@ extendImportTests = testGroup "extend import actions" , "b :: A" , "b = ConstructorFoo" ]) - , ignoreForGHC94 "On GHC 9.4, the error messages with -fdefer-type-errors don't have necessary imported target srcspan info." $ + , brokenForGHC94 "On GHC 9.4, the error messages with -fdefer-type-errors don't have necessary imported target srcspan info." $ testSession "extend single line qualified import with value" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where" @@ -1487,7 +1486,7 @@ extendImportTests = testGroup "extend import actions" , "import A (pattern Some)" , "k (Some x) = x" ]) - , ignoreFor (BrokenForGHC [GHC92, GHC94]) "Diagnostic message has no suggestions" $ + , ignoreForGhcVersions [GHC92, GHC94] "Diagnostic message has no suggestions" $ testSession "type constructor name same as data constructor name" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where" @@ -1753,7 +1752,7 @@ suggestImportTests = testGroup "suggest import actions" suggestAddRecordFieldImportTests :: TestTree suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields when using OverloadedRecordDot" [ testGroup "The field is suggested when an instance resolution failure occurs" - [ ignoreFor (BrokenForGHC [GHC90, GHC94, GHC96]) "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest + [ ignoreForGhcVersions [GHC90, GHC94, GHC96] "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest ] ] where @@ -3195,7 +3194,7 @@ exportUnusedTests = testGroup "export unused actions" (R 2 0 2 11) "Export ‘bar’" Nothing - , ignoreFor (BrokenForGHC [GHC92, GHC94]) "Diagnostic message has no suggestions" $ + , ignoreForGhcVersions [GHC92, GHC94] "Diagnostic message has no suggestions" $ testSession "type is exported but not the constructor of same name" $ template (T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" @@ -3845,45 +3844,10 @@ withTempDir f = System.IO.Extra.withTempDir $ \dir -> do f dir' ignoreForGHC92 :: String -> TestTree -> TestTree -ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92]) - -ignoreForGHC94 :: String -> TestTree -> TestTree -ignoreForGHC94 = knownIssueFor Broken (BrokenForGHC [GHC94]) - -data BrokenTarget = - BrokenSpecific OS [GhcVersion] - -- ^Broken for `BrokenOS` with `GhcVersion` - | BrokenForOS OS - -- ^Broken for `BrokenOS` - | BrokenForGHC [GhcVersion] - -- ^Broken for `GhcVersion` - deriving (Show) - --- | Ignore test for specific os and ghc with reason. -ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree -ignoreFor = knownIssueFor Ignore - --- | Deal with `IssueSolution` for specific OS and GHC. -knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree -knownIssueFor solution = go . \case - BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers - BrokenForOS bos -> isTargetOS bos - BrokenForGHC vers -> isTargetGhc vers - where - isTargetOS = \case - Windows -> isWindows - MacOS -> isMac - Linux -> not isWindows && not isMac - - isTargetGhc = elem ghcVersion - - go True = case solution of - Broken -> expectFailBecause - Ignore -> ignoreTestBecause - go False = \_ -> id - +ignoreForGHC92 = ignoreForGhcVersions [GHC92] -data IssueSolution = Broken | Ignore deriving (Show) +brokenForGHC94 :: String -> TestTree -> TestTree +brokenForGHC94 = knownBrokenForGhcVersions [GHC94] -- | Assert that a value is not 'Nothing', and extract the value. assertJust :: MonadIO m => String -> Maybe a -> m a