Skip to content

Commit 59513ff

Browse files
fendorfendor
committed
Add regression test for source plugins
Demonstrates the issue #4631
1 parent 7d5bb28 commit 59513ff

File tree

7 files changed

+133
-33
lines changed

7 files changed

+133
-33
lines changed

‎ghcide-test/data/plugin-parser/cabal.project‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
packages: ./plugin
2+
./usage

‎ghcide-test/data/plugin-parser/plugin/Plugin.hs‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
module Plugin (plugin) where
3+
4+
import Control.Monad.IO.Class (MonadIO (..))
5+
import Data.Foldable (for_)
6+
import Data.List (foldl')
7+
import Data.List.NonEmpty (NonEmpty (..))
8+
import Data.Traversable (for)
9+
10+
import qualified Data.Generics as SYB
11+
12+
import qualified GHC.Plugins as GHC
13+
import GHC
14+
15+
plugin :: GHC.Plugin
16+
plugin = GHC.defaultPlugin
17+
{ GHC.parsedResultAction = \_cliOptions -> pluginImpl
18+
}
19+
20+
pluginImpl :: GHC.ModSummary -> GHC.ParsedResult -> GHC.Hsc GHC.ParsedResult
21+
pluginImpl _modSummary pm = do
22+
let m = GHC.parsedResultModule pm
23+
hpm_module' <- transform (GHC.hpm_module m)
24+
let module' = m { GHC.hpm_module = hpm_module' }
25+
return pm { GHC.parsedResultModule = module' }
26+
27+
transform
28+
:: GHC.Located (HsModule GhcPs)
29+
-> GHC.Hsc (GHC.Located (HsModule GhcPs))
30+
transform = SYB.everywhereM (SYB.mkM transform') where
31+
transform' :: LHsExpr GhcPs -> GHC.Hsc (LHsExpr GhcPs)
32+
transform' expr@(L srcSpan (HsVar _ lvar)) =
33+
if GHC.occNameString (GHC.occName $ GHC.unLoc lvar) == "pluginConstant"
34+
then return (nlHsIntLit 0x42)
35+
else return expr
36+
transform' expr =
37+
return expr

‎ghcide-test/data/plugin-parser/plugin/plugin.cabal‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
cabal-version: 1.18
2+
name: plugin
3+
version: 1.0.0
4+
build-type: Simple
5+
6+
library
7+
build-depends: base, ghc, syb
8+
exposed-modules: Plugin
9+
hs-source-dirs: .

‎ghcide-test/data/plugin-parser/usage/File1.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
module File1 where
3+
4+
import File2
5+
6+
bar = foo * foo

‎ghcide-test/data/plugin-parser/usage/File2.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module File2 where
2+
3+
foo :: Int
4+
foo = pluginConstant

‎ghcide-test/data/plugin-parser/usage/usage.cabal‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
cabal-version: 1.18
2+
name: usage
3+
version: 1.0.0
4+
build-type: Simple
5+
6+
library
7+
build-depends: base, plugin
8+
exposed-modules: File1 File2
9+
ghc-options: -fplugin Plugin
10+
hs-source-dirs: .

‎ghcide-test/exe/PluginSimpleTests.hs‎

Lines changed: 65 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@
22
module PluginSimpleTests (tests) where
33

44
import Config
5-
import Control.Monad.IO.Class (liftIO)
65
import Development.IDE.Test (expectDiagnostics)
76
import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..),
87
SemanticTokenRelative (..),
@@ -11,37 +10,70 @@ import Language.LSP.Test
1110
import System.FilePath
1211
import Test.Hls.FileSystem
1312
import Test.Tasty
13+
import qualified Test.Hls.FileSystem as FS
1414

1515
tests :: TestTree
16-
tests =
17-
-- Build profile: -w ghc-9.4.2 -O1
18-
-- In order, the following will be built (use -v for more details):
19-
-- - ghc-typelits-natnormalise-0.7.7 (lib) (requires build)
20-
-- - ghc-typelits-knownnat-0.7.7 (lib) (requires build)
21-
-- - plugin-1.0.0 (lib) (first run)
22-
-- Starting ghc-typelits-natnormalise-0.7.7 (lib)
23-
-- Building ghc-typelits-natnormalise-0.7.7 (lib)
24-
25-
-- Failed to build ghc-typelits-natnormalise-0.7.7.
26-
-- Build log (
27-
-- C:\cabal\logs\ghc-9.4.2\ghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.log
28-
-- ):
29-
-- Preprocessing library for ghc-typelits-natnormalise-0.7.7..
30-
-- Building library for ghc-typelits-natnormalise-0.7.7..
31-
-- [1 of 3] Compiling GHC.TypeLits.Normalise.SOP ( src\GHC\TypeLits\Normalise\SOP.hs, dist\build\GHC\TypeLits\Normalise\SOP.o )
32-
-- [2 of 3] Compiling GHC.TypeLits.Normalise.Unify ( src\GHC\TypeLits\Normalise\Unify.hs, dist\build\GHC\TypeLits\Normalise\Unify.o )
33-
-- [3 of 3] Compiling GHC.TypeLits.Normalise ( src-ghc-9.4\GHC\TypeLits\Normalise.hs, dist\build\GHC\TypeLits\Normalise.o )
34-
-- C:\tools\ghc-9.4.2\lib\../mingw/bin/llvm-ar.exe: error: dist\build\objs-5156\libHSghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.a: No such file or directory
35-
36-
-- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is
37-
-- required by plugin-1.0.0). See the build log above for details.
38-
testWithExtraFiles "simple plugin" "plugin-knownnat" $ \dir -> do
39-
_ <- openDoc (dir </> "KnownNat.hs") "haskell"
40-
liftIO $ atomicFileWriteString (dir</>"hie.yaml")
41-
"cradle: {cabal: [{path: '.', component: 'lib:plugin'}]}"
42-
43-
expectDiagnostics
44-
[ ( "KnownNat.hs",
45-
[(DiagnosticSeverity_Error, (9, 15), "Variable not in scope: c", Just "GHC-88464")]
46-
)
47-
]
16+
tests = testGroup "ghc-plugins"
17+
[
18+
-- Build profile: -w ghc-9.4.2 -O1
19+
-- In order, the following will be built (use -v for more details):
20+
-- - ghc-typelits-natnormalise-0.7.7 (lib) (requires build)
21+
-- - ghc-typelits-knownnat-0.7.7 (lib) (requires build)
22+
-- - plugin-1.0.0 (lib) (first run)
23+
-- Starting ghc-typelits-natnormalise-0.7.7 (lib)
24+
-- Building ghc-typelits-natnormalise-0.7.7 (lib)
25+
26+
-- Failed to build ghc-typelits-natnormalise-0.7.7.
27+
-- Build log (
28+
-- C:\cabal\logs\ghc-9.4.2\ghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.log
29+
-- ):
30+
-- Preprocessing library for ghc-typelits-natnormalise-0.7.7..
31+
-- Building library for ghc-typelits-natnormalise-0.7.7..
32+
-- [1 of 3] Compiling GHC.TypeLits.Normalise.SOP ( src\GHC\TypeLits\Normalise\SOP.hs, dist\build\GHC\TypeLits\Normalise\SOP.o )
33+
-- [2 of 3] Compiling GHC.TypeLits.Normalise.Unify ( src\GHC\TypeLits\Normalise\Unify.hs, dist\build\GHC\TypeLits\Normalise\Unify.o )
34+
-- [3 of 3] Compiling GHC.TypeLits.Normalise ( src-ghc-9.4\GHC\TypeLits\Normalise.hs, dist\build\GHC\TypeLits\Normalise.o )
35+
-- C:\tools\ghc-9.4.2\lib\../mingw/bin/llvm-ar.exe: error: dist\build\objs-5156\libHSghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.a: No such file or directory
36+
37+
-- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is
38+
-- required by plugin-1.0.0). See the build log above for details.
39+
testWithDummyPlugin "simple plugin" pluginKnownNatVfs $ do
40+
_ <- openDoc "KnownNat.hs" "haskell"
41+
42+
expectDiagnostics
43+
[ ( "KnownNat.hs",
44+
[(DiagnosticSeverity_Error, (9, 15), "Variable not in scope: c", Just "GHC-88464")]
45+
)
46+
]
47+
, testWithDummyPlugin "simple parser plugin" pluginParsreVfs $ do
48+
_ <- openDoc "usage/File1.hs" "haskell"
49+
50+
expectDiagnostics
51+
[ ( ("usage" </> "File1.hs"),
52+
[(DiagnosticSeverity_Warning, (5, 0), "Top-level binding with no type signature: bar :: Int", Just "GHC-38417")]
53+
)
54+
]
55+
]
56+
57+
pluginKnownNatVfs :: VirtualFileTree
58+
pluginKnownNatVfs = FS.mkVirtualFileTree ("ghcide-test" </> "data" </> "plugin-knownnat") $
59+
FS.simpleCabalProject
60+
[ "cabal.project"
61+
, "KnownNat.hs"
62+
, "plugin.cabal"
63+
]
64+
65+
pluginParsreVfs :: VirtualFileTree
66+
pluginParsreVfs = FS.mkVirtualFileTree ("ghcide-test" </> "data" </> "plugin-parser") $
67+
[ simpleCabalCradle
68+
, copy "cabal.project"
69+
, directory "plugin"
70+
[ copy "plugin/Plugin.hs"
71+
, copy "plugin/plugin.cabal"
72+
]
73+
, directory "usage"
74+
[ copy "usage/File1.hs"
75+
, copy "usage/File2.hs"
76+
, copy "usage/usage.cabal"
77+
]
78+
]
79+

0 commit comments

Comments
 (0)