From 03e34261307ea078b5209451a113f2594d8cc41c Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 2 Nov 2022 14:46:37 +0100 Subject: [PATCH 1/3] Make HLS refactor use the existing ignore test infrastructure --- hls-test-utils/src/Test/Hls/Util.hs | 32 +++++++++++++++++--- plugins/hls-refactor-plugin/test/Main.hs | 37 +----------------------- 2 files changed, 29 insertions(+), 40 deletions(-) diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index 5ab1e093dd..f177d432bf 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -28,15 +28,20 @@ module Test.Hls.Util , inspectCodeAction , inspectCommand , inspectDiagnostic + -- * Mark tests as broken for various reasons. , knownBrokenOnWindows , knownBrokenForGhcVersions + , knownIssueInEnv , knownBrokenInEnv , onlyWorkForGhcVersions + -- * Setup test-suite state , setupBuildToolFiles + -- * Diagnostics helpers , SymbolLocation , waitForDiagnosticsFrom , waitForDiagnosticsFromSource , waitForDiagnosticsFromSourceWithTimeout + -- * Working directory modifications , withCurrentDirectoryInTmp , withCurrentDirectoryInTmp' , withCanonicalTempDir @@ -115,7 +120,19 @@ files = -- , "./test/testdata/wErrorTest/" ] -data EnvSpec = HostOS OS | GhcVer GhcVersion +-- | Why is the test broken? +-- +-- Are they broken for the given spec or are we just ignoring the test +-- because the test doesn't make sense in the Environment. +data IssueSolution + = Broken + -- ^ Mark a test as known broken, expecting the test to be fixed eventually. + | Ignore + -- ^ Mark a test as ignored, because the test doesn't make sense in the + -- associated environment. + deriving (Show) + +data EnvSpec = HostOS OS | GhcVer GhcVersion | Specific OS GhcVersion deriving (Show, Eq) matchesCurrentEnv :: EnvSpec -> Bool @@ -131,11 +148,18 @@ hostOS | isMac = MacOS | otherwise = Linux +-- | Mark the given TestTree as having a known issue if /any/ of environmental +-- spec matches the current environment. +knownIssueInEnv :: IssueSolution -> [EnvSpec] -> String -> TestTree -> TestTree +knownIssueInEnv issueSolution envSpecs reason + | any matchesCurrentEnv envSpecs = case issueSolution of + Broken -> expectFailBecause reason + Ignore -> ignoreTestBecause reason + | otherwise = id + -- | Mark as broken if /any/ of environmental spec mathces the current environment. knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree -knownBrokenInEnv envSpecs reason - | any matchesCurrentEnv envSpecs = expectFailBecause reason - | otherwise = id +knownBrokenInEnv = knownIssueInEnv Broken knownBrokenOnWindows :: String -> TestTree -> TestTree knownBrokenOnWindows = knownBrokenInEnv [HostOS Windows] diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 599d4bde29..d283711e7f 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -3719,42 +3719,7 @@ withTempDir f = System.IO.Extra.withTempDir $ \dir -> do f dir' ignoreForGHC92 :: String -> TestTree -> TestTree -ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92]) - -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 - - -data IssueSolution = Broken | Ignore deriving (Show) +ignoreForGHC92 = knownIssueInEnv Ignore [GhcVer GHC92] -- | Assert that a value is not 'Nothing', and extract the value. assertJust :: MonadIO m => String -> Maybe a -> m a From 577d6c1f7c5508bfcc71513bd5076dc8aa159774 Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 2 Nov 2022 14:46:49 +0100 Subject: [PATCH 2/3] Extract ghcide-tests into its own package Move ghcide-test-utils to a top-level directory. Extrace ghcide-tests into its own package, s.t. it can depend on hls-test-utils for defining tests. In particular, it should use the same infrastructure for ignoring tests. --- .github/workflows/test.yml | 6 +- cabal.project | 1 + flake.nix | 3 +- ghcide/ghcide-test-utils/LICENSE | 201 ++++++++++++++++++ .../ghcide-test-utils.cabal | 0 .../src/Development/IDE/Test.hs | 0 .../src/Development/IDE/Test/Diagnostic.hs | 0 ghcide/ghcide.cabal | 84 -------- ghcide/test/ghcide-tests.cabal | 106 +++++++++ stack-lts19.yaml | 1 + stack.yaml | 1 + 11 files changed, 315 insertions(+), 88 deletions(-) create mode 100644 ghcide/ghcide-test-utils/LICENSE rename ghcide/{test => ghcide-test-utils}/ghcide-test-utils.cabal (100%) rename ghcide/{test => ghcide-test-utils}/src/Development/IDE/Test.hs (100%) rename ghcide/{test => ghcide-test-utils}/src/Development/IDE/Test/Diagnostic.hs (100%) create mode 100644 ghcide/test/ghcide-tests.cabal diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index bae4d974a8..1cba29536e 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -106,7 +106,7 @@ jobs: os: ${{ runner.os }} - name: Build - run: cabal build + run: cabal build - name: Set test options # run the tests without parallelism, otherwise tasty will attempt to run @@ -130,7 +130,7 @@ jobs: - if: needs.pre_job.outputs.should_skip_ghcide != 'true' && matrix.test name: Test ghcide # run the tests without parallelism to avoid running out of memory - run: cabal test ghcide --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test ghcide --test-options="$TEST_OPTS" + run: cabal test ghcide-tests --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test ghcide-tests --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-plugin-api @@ -148,7 +148,7 @@ jobs: env: HLS_TEST_EXE: hls HLS_WRAPPER_TEST_EXE: hls-wrapper - run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" + run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-brittany-plugin diff --git a/cabal.project b/cabal.project index 4950a95f3a..050cf01fa2 100644 --- a/cabal.project +++ b/cabal.project @@ -5,6 +5,7 @@ packages: ./hls-graph ./ghcide ./ghcide-bench + ./ghcide/ghcide-test-utils ./ghcide/test ./hls-plugin-api ./hls-test-utils diff --git a/flake.nix b/flake.nix index 1e4a30ab26..bd02426ac5 100644 --- a/flake.nix +++ b/flake.nix @@ -157,7 +157,8 @@ hie-compat = ./hie-compat; hls-plugin-api = ./hls-plugin-api; hls-test-utils = ./hls-test-utils; - ghcide-test-utils = ./ghcide/test; + ghcide-test-utils = ./ghcide/ghcide-test-utils; + ghcide-tests = ./ghcide/test; # hiedb depends on hie-compact, which is part of this repository. If # cabal inside the nix development shell tries to use the hiedb # compiled inside nix, it thinks that this package is broken and diff --git a/ghcide/ghcide-test-utils/LICENSE b/ghcide/ghcide-test-utils/LICENSE new file mode 100644 index 0000000000..d1f5c9033f --- /dev/null +++ b/ghcide/ghcide-test-utils/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright 2019 Digital Asset (Switzerland) GmbH and/or its affiliates + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/ghcide/test/ghcide-test-utils.cabal b/ghcide/ghcide-test-utils/ghcide-test-utils.cabal similarity index 100% rename from ghcide/test/ghcide-test-utils.cabal rename to ghcide/ghcide-test-utils/ghcide-test-utils.cabal diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/ghcide-test-utils/src/Development/IDE/Test.hs similarity index 100% rename from ghcide/test/src/Development/IDE/Test.hs rename to ghcide/ghcide-test-utils/src/Development/IDE/Test.hs diff --git a/ghcide/test/src/Development/IDE/Test/Diagnostic.hs b/ghcide/ghcide-test-utils/src/Development/IDE/Test/Diagnostic.hs similarity index 100% rename from ghcide/test/src/Development/IDE/Test/Diagnostic.hs rename to ghcide/ghcide-test-utils/src/Development/IDE/Test/Diagnostic.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 5d0b50b921..5e4b05bdf1 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -312,87 +312,3 @@ executable ghcide cpp-options: -DMONITORING_EKG if impl(ghc >= 9) ghc-options: -Wunused-packages - - -test-suite ghcide-tests - type: exitcode-stdio-1.0 - default-language: Haskell2010 - build-tool-depends: - ghcide:ghcide, - ghcide:ghcide-test-preprocessor, - implicit-hie:gen-hie - build-depends: - aeson, - async, - base, - containers, - data-default, - directory, - extra, - filepath, - fuzzy, - -------------------------------------------------------------- - -- The MIN_VERSION_ghc macro relies on MIN_VERSION pragmas - -- which require depending on ghc. So the tests need to depend - -- on ghc if they need to use MIN_VERSION_ghc. Maybe a - -- better solution can be found, but this is a quick solution - -- which works for now. - ghc, - -------------------------------------------------------------- - ghcide, - lsp, - lsp-types, - hls-plugin-api, - lens, - list-t, - lsp-test ^>= 0.14, - monoid-subclasses, - network-uri, - QuickCheck, - random, - regex-tdfa ^>= 1.3.1, - shake, - sqlite-simple, - stm, - stm-containers, - tasty, - tasty-expected-failure, - tasty-hunit >= 0.10, - tasty-quickcheck, - tasty-rerun, - text, - text-rope, - unordered-containers, - if impl(ghc < 9.2) - build-depends: - record-dot-preprocessor, - record-hasfield - if impl(ghc < 9.3) - build-depends: ghc-typelits-knownnat - if impl(ghc >= 9) - ghc-options: -Wunused-packages - hs-source-dirs: test/cabal test/exe test/src - ghc-options: -threaded -Wall -Wno-name-shadowing -O0 -Wno-unticked-promoted-constructors - main-is: Main.hs - other-modules: - Development.IDE.Test.Runfiles - FuzzySearch - Progress - HieDbRetry - Development.IDE.Test - Development.IDE.Test.Diagnostic - default-extensions: - BangPatterns - DeriveFunctor - DeriveGeneric - FlexibleContexts - GeneralizedNewtypeDeriving - LambdaCase - NamedFieldPuns - OverloadedStrings - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - TupleSections - TypeApplications - ViewPatterns diff --git a/ghcide/test/ghcide-tests.cabal b/ghcide/test/ghcide-tests.cabal new file mode 100644 index 0000000000..6933612456 --- /dev/null +++ b/ghcide/test/ghcide-tests.cabal @@ -0,0 +1,106 @@ +cabal-version: 3.0 +-- Extracted the test-suite into its own package, s.t. that it can depend +-- on hls-test-utils. It can't be part of ghcide package, because hls-test-utils +-- depends on ghcide. +build-type: Simple +category: Development +name: ghcide-tests +version: 1.8.0.0 +license: Apache-2.0 +license-file: LICENSE +author: Digital Asset and Ghcide contributors +maintainer: Ghcide contributors +copyright: Digital Asset and Ghcide contributors 2018-2022 +synopsis: Test utils for ghcide +description: + Testsuite for ghcide +homepage: https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme +bug-reports: https://github.com/haskell/haskell-language-server/issues +tested-with: GHC == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 || == 9.4.2 + +source-repository head + type: git + location: https://github.com/haskell/haskell-language-server.git + + +test-suite ghcide-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + build-tool-depends: + ghcide:ghcide, + ghcide:ghcide-test-preprocessor, + implicit-hie:gen-hie + build-depends: + aeson, + async, + base, + containers, + data-default, + directory, + extra, + filepath, + fuzzy, + -------------------------------------------------------------- + -- The MIN_VERSION_ghc macro relies on MIN_VERSION pragmas + -- which require depending on ghc. So the tests need to depend + -- on ghc if they need to use MIN_VERSION_ghc. Maybe a + -- better solution can be found, but this is a quick solution + -- which works for now. + ghc, + -------------------------------------------------------------- + ghcide, + ghcide-test-utils, + lsp, + lsp-types, + hls-plugin-api, + lens, + list-t, + lsp-test ^>= 0.14, + monoid-subclasses, + network-uri, + QuickCheck, + random, + regex-tdfa ^>= 1.3.1, + shake, + sqlite-simple, + stm, + stm-containers, + tasty, + tasty-expected-failure, + tasty-hunit >= 0.10, + tasty-quickcheck, + tasty-rerun, + text, + text-rope, + unordered-containers, + if impl(ghc < 9.2) + build-depends: + record-dot-preprocessor, + record-hasfield + if impl(ghc < 9.3) + build-depends: ghc-typelits-knownnat + if impl(ghc >= 9) + ghc-options: -Wunused-packages + hs-source-dirs: cabal exe src + ghc-options: -threaded -Wall -Wno-name-shadowing -O0 -Wno-unticked-promoted-constructors + main-is: Main.hs + other-modules: + Development.IDE.Test.Runfiles + FuzzySearch + Progress + HieDbRetry + default-extensions: + BangPatterns + DeriveFunctor + DeriveGeneric + FlexibleContexts + GeneralizedNewtypeDeriving + LambdaCase + NamedFieldPuns + OverloadedStrings + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + ViewPatterns diff --git a/stack-lts19.yaml b/stack-lts19.yaml index af599c2112..71192dd6eb 100644 --- a/stack-lts19.yaml +++ b/stack-lts19.yaml @@ -5,6 +5,7 @@ packages: - ./hie-compat - ./hls-graph - ./ghcide/ + - ./ghcide/ghcide-test-utils - ./ghcide/test - ./hls-plugin-api - ./hls-test-utils diff --git a/stack.yaml b/stack.yaml index 914b0a980b..11fa8483dd 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,6 +5,7 @@ packages: - ./hie-compat - ./hls-graph - ./ghcide/ +- ./ghcide/ghcide-test-utils - ./ghcide/test - ./hls-plugin-api - ./hls-test-utils From 2ff3b6c39f3bf582b77bb80d609d0cc9436cfe9e Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 2 Nov 2022 15:12:23 +0100 Subject: [PATCH 3/3] Make ghcide-tests depend on hls-test-utils --- ghcide/test/exe/Main.hs | 232 ++++++++++++---------------- ghcide/test/ghcide-tests.cabal | 1 + hls-test-utils/src/Test/Hls/Util.hs | 13 ++ 3 files changed, 113 insertions(+), 133 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index accfade90e..7fc13d14b1 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -17,124 +17,122 @@ module Main (main) where import Control.Applicative.Combinators import Control.Concurrent -import Control.Exception (bracket_, catch, - finally) -import qualified Control.Lens as Lens +import Control.Exception (bracket_, catch, finally) +import qualified Control.Lens as Lens import Control.Monad -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Aeson (toJSON) -import qualified Data.Aeson as A +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson (toJSON) +import qualified Data.Aeson as A import Data.Default import Data.Foldable import Data.List.Extra import Data.Maybe -import qualified Data.Set as Set -import qualified Data.Text as T -import Data.Text.Utf16.Rope (Rope) -import qualified Data.Text.Utf16.Rope as Rope -import Development.IDE.Core.PositionMapping (PositionResult (..), - fromCurrent, - positionResultToMaybe, - toCurrent) -import Development.IDE.GHC.Compat (GhcVersion (..), - ghcVersion) +import qualified Data.Set as Set +import qualified Data.Text as T +import Data.Text.Utf16.Rope (Rope) +import qualified Data.Text.Utf16.Rope as Rope +import Development.IDE.Core.PositionMapping (PositionResult (..), + fromCurrent, + positionResultToMaybe, + toCurrent) +import Development.IDE.GHC.Compat (GhcVersion (..), + ghcVersion) import Development.IDE.GHC.Util -import qualified Development.IDE.Main as IDE -import Development.IDE.Plugin.TypeLenses (typeLensCommandId) +import qualified Development.IDE.Main as IDE +import Development.IDE.Plugin.TypeLenses (typeLensCommandId) import Development.IDE.Spans.Common -import Development.IDE.Test (Cursor, - canonicalizeUri, - configureCheckProject, - diagnostic, - expectCurrentDiagnostics, - expectDiagnostics, - expectDiagnosticsWithTags, - expectNoMoreDiagnostics, - flushMessages, - getInterfaceFilesDir, - getStoredKeys, - isReferenceReady, - referenceReady, - standardizeQuotes, - waitForAction, - waitForGC, - waitForTypecheck) +import Development.IDE.Test (Cursor, canonicalizeUri, + configureCheckProject, + diagnostic, + expectCurrentDiagnostics, + expectDiagnostics, + expectDiagnosticsWithTags, + expectNoMoreDiagnostics, + flushMessages, + getInterfaceFilesDir, + getStoredKeys, + isReferenceReady, + referenceReady, + standardizeQuotes, + waitForAction, waitForGC, + waitForTypecheck) import Development.IDE.Test.Runfiles -import qualified Development.IDE.Types.Diagnostics as Diagnostics +import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location -import Development.Shake (getDirectoryFilesIO) +import Development.Shake (getDirectoryFilesIO) import Ide.Plugin.Config import Language.LSP.Test -import Language.LSP.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length), - SemanticTokensEdit (_start), - mkRange) +import Language.LSP.Types hiding + (SemanticTokenAbsolute (length, line), + SemanticTokenRelative (length), + SemanticTokensEdit (_start), + mkRange) import Language.LSP.Types.Capabilities -import qualified Language.LSP.Types.Lens as Lens (label) -import qualified Language.LSP.Types.Lens as Lsp (diagnostics, - message, - params) -import Language.LSP.VFS (VfsLog, applyChange) +import qualified Language.LSP.Types.Lens as Lens (label) +import qualified Language.LSP.Types.Lens as Lsp (diagnostics, + message, params) +import Language.LSP.VFS (VfsLog, applyChange) import Network.URI import System.Directory -import System.Environment.Blank (getEnv, setEnv, - unsetEnv) -import System.Exit (ExitCode (ExitSuccess)) +import System.Environment.Blank (getEnv, setEnv, unsetEnv) +import System.Exit (ExitCode (ExitSuccess)) import System.FilePath -import System.Info.Extra (isMac, isWindows) +import System.Info.Extra (isMac, isWindows) import qualified System.IO.Extra -import System.IO.Extra hiding (withTempDir) -import System.Mem (performGC) -import System.Process.Extra (CreateProcess (cwd), - createPipe, proc, - readCreateProcessWithExitCode) +import System.IO.Extra hiding (withTempDir) +import System.Mem (performGC) +import System.Process.Extra (CreateProcess (cwd), + createPipe, proc, + readCreateProcessWithExitCode) import Test.QuickCheck -- import Test.QuickCheck.Instances () import Control.Concurrent.Async -import Control.Lens (to, (.~), (^.)) -import Control.Monad.Extra (whenJust) -import Data.Function ((&)) -import Data.Functor.Identity (runIdentity) +import Control.Lens (to, (.~), (^.)) +import Control.Monad.Extra (whenJust) +import Data.Function ((&)) +import Data.Functor.Identity (runIdentity) import Data.IORef -import Data.IORef.Extra (atomicModifyIORef_) -import Data.String (IsString (fromString)) +import Data.IORef.Extra (atomicModifyIORef_) +import Data.String (IsString (fromString)) import Data.Tuple.Extra -import Development.IDE.Core.FileStore (getModTime) -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Development.IDE.Plugin.Test (TestRequest (BlockSeconds), - WaitForIdeRuleResult (..), - blockCommandId) -import Development.IDE.Types.Logger (Logger (Logger), - LoggingColumn (DataColumn, PriorityColumn), - Pretty (pretty), - Priority (Debug), - Recorder (Recorder, logger_), - WithPriority (WithPriority, priority), - cfilter, - cmapWithPrio, - makeDefaultStderrRecorder, - toCologActionWithPrio) +import Development.IDE.Core.FileStore (getModTime) +import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide +import Development.IDE.Plugin.Test (TestRequest (BlockSeconds), + WaitForIdeRuleResult (..), + blockCommandId) +import Development.IDE.Types.Logger (Logger (Logger), + LoggingColumn (DataColumn, PriorityColumn), + Pretty (pretty), + Priority (Debug), + Recorder (Recorder, logger_), + WithPriority (WithPriority, priority), + cfilter, cmapWithPrio, + makeDefaultStderrRecorder, + toCologActionWithPrio) import qualified FuzzySearch -import GHC.Stack (emptyCallStack) +import GHC.Stack (emptyCallStack) import qualified HieDbRetry -import Ide.PluginUtils (pluginDescToIdePlugins) +import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types -import qualified Language.LSP.Types as LSP -import Language.LSP.Types.Lens (didChangeWatchedFiles, - workspace) -import qualified Language.LSP.Types.Lens as L +import qualified Language.LSP.Types as LSP +import Language.LSP.Types.Lens (didChangeWatchedFiles, + workspace) +import qualified Language.LSP.Types.Lens as L import qualified Progress import System.Time.Extra -import qualified Test.QuickCheck.Monadic as MonadicQuickCheck -import Test.QuickCheck.Monadic (forAllM, monadicIO) +import qualified Test.Hls.Util as Util +import Test.Hls.Util (EnvSpec (..), + IssueSolution (..), + OS (..)) +import qualified Test.QuickCheck.Monadic as MonadicQuickCheck +import Test.QuickCheck.Monadic (forAllM, monadicIO) import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit import Test.Tasty.Ingredients.Rerun import Test.Tasty.QuickCheck -import Text.Printf (printf) -import Text.Regex.TDFA ((=~)) +import Text.Printf (printf) +import Text.Regex.TDFA ((=~)) data Log = LogGhcIde Ghcide.Log @@ -2001,10 +1999,10 @@ completionDocTests = test doc (Position 1 7) "id" (Just $ T.length expected) [expected] ] where - brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9" - brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2" + brokenForGhc9 = knownBrokenFor (Util.forGhcVersions [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9" + brokenForWinGhc9 = knownBrokenFor (Util.brokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2" -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903 - brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9" + brokenForMacGhc9 = knownBrokenFor (Util.brokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9" test doc pos label mn expected = do _ <- waitForDiagnostics compls <- getCompletions doc pos @@ -2271,57 +2269,25 @@ xfail :: TestTree -> String -> TestTree xfail = flip expectFailBecause ignoreInWindowsBecause :: String -> TestTree -> TestTree -ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows) +ignoreInWindowsBecause = ignoreFor [HostOS Windows] ignoreInWindowsForGHC810 :: TestTree -> TestTree ignoreInWindowsForGHC810 = - ignoreFor (BrokenSpecific Windows [GHC810]) "tests are unreliable in windows for ghc 8.10" + ignoreFor [Specific Windows GHC810] "tests are unreliable in windows for ghc 8.10" ignoreForGHC92Plus :: String -> TestTree -> TestTree -ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94]) +ignoreForGHC92Plus = ignoreFor (Util.forGhcVersions [GHC92, GHC94]) knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree -knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers) - -data BrokenOS = Linux | MacOS | Windows deriving (Show) - -data IssueSolution = Broken | Ignore deriving (Show) - -data BrokenTarget = - BrokenSpecific BrokenOS [GhcVersion] - -- ^Broken for `BrokenOS` with `GhcVersion` - | BrokenForOS BrokenOS - -- ^Broken for `BrokenOS` - | BrokenForGHC [GhcVersion] - -- ^Broken for `GhcVersion` - deriving (Show) +knownBrokenForGhcVersions ghcVers = knownBrokenFor (Util.forGhcVersions ghcVers) -- | Ignore test for specific os and ghc with reason. -ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree -ignoreFor = knownIssueFor Ignore +ignoreFor :: [EnvSpec] -> String -> TestTree -> TestTree +ignoreFor = Util.knownIssueInEnv Ignore -- | Known broken for specific os and ghc with reason. -knownBrokenFor :: BrokenTarget -> String -> TestTree -> TestTree -knownBrokenFor = knownIssueFor Broken - --- | 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 +knownBrokenFor :: [EnvSpec] -> String -> TestTree -> TestTree +knownBrokenFor = Util.knownIssueInEnv Broken data Expect = ExpectRange Range -- Both gotoDef and hover should report this range @@ -3107,10 +3073,10 @@ runWithExtraFiles prefix s = withTempDir $ \dir -> do copyTestDataFiles :: FilePath -> FilePath -> IO () copyTestDataFiles dir prefix = do -- Copy all the test data files to the temporary workspace - testDataFiles <- getDirectoryFilesIO ("test/data" prefix) ["//*"] + testDataFiles <- getDirectoryFilesIO ("data" prefix) ["//*"] for_ testDataFiles $ \f -> do createDirectoryIfMissing True $ dir takeDirectory f - copyFile ("test/data" prefix f) (dir f) + copyFile ("data" prefix f) (dir f) run' :: (FilePath -> Session a) -> IO a run' s = withTempDir $ \dir -> runInDir dir (s dir) @@ -3181,7 +3147,7 @@ lspTestCapsNoFileWatches = lspTestCaps & workspace . Lens._Just . didChangeWatch openTestDataDoc :: FilePath -> Session TextDocumentIdentifier openTestDataDoc path = do - source <- liftIO $ readFileUtf8 $ "test/data" path + source <- liftIO $ readFileUtf8 $ "data" path createDoc path "haskell" source unitTests :: Recorder (WithPriority Log) -> Logger -> TestTree diff --git a/ghcide/test/ghcide-tests.cabal b/ghcide/test/ghcide-tests.cabal index 6933612456..4c861dde45 100644 --- a/ghcide/test/ghcide-tests.cabal +++ b/ghcide/test/ghcide-tests.cabal @@ -53,6 +53,7 @@ test-suite ghcide-tests lsp, lsp-types, hls-plugin-api, + hls-test-utils, lens, list-t, lsp-test ^>= 0.14, diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index f177d432bf..93d484a599 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -20,7 +20,9 @@ module Test.Hls.Util , getCompletionByLabel , ghcVersion, GhcVersion(..) , hostOS, OS(..) + , IssueSolution(..) , matchesCurrentEnv, EnvSpec(..) + , forGhcVersions, brokenSpecific , noLiteralCaps , ignoreForGhcVersions , ignoreInEnv @@ -138,6 +140,8 @@ data EnvSpec = HostOS OS | GhcVer GhcVersion | Specific OS GhcVersion matchesCurrentEnv :: EnvSpec -> Bool matchesCurrentEnv (HostOS os) = hostOS == os matchesCurrentEnv (GhcVer ver) = ghcVersion == ver +matchesCurrentEnv (Specific os ver) = + hostOS == os && ghcVersion == ver data OS = Windows | MacOS | Linux deriving (Show, Eq) @@ -148,6 +152,15 @@ hostOS | isMac = MacOS | otherwise = Linux +-- | Helper to mark a test as broken for the given GhcVersions +forGhcVersions :: [GhcVersion] -> [EnvSpec] +forGhcVersions = map GhcVer + +-- | Helper to create many specific environment specifications +-- for a single OS. +brokenSpecific :: OS -> [GhcVersion] -> [EnvSpec] +brokenSpecific os = map (Specific os) + -- | Mark the given TestTree as having a known issue if /any/ of environmental -- spec matches the current environment. knownIssueInEnv :: IssueSolution -> [EnvSpec] -> String -> TestTree -> TestTree