diff options
Diffstat (limited to 'testsuite/tests')
19 files changed, 297 insertions, 2 deletions
diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index 3e983fded6..6c823cc5d5 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -21,6 +21,34 @@ plugins08: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins08.hs -package-db simple-plugin/pkg.plugins08/local.package.conf ./plugins08 +.PHONY: plugins09 +plugins09: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins09.hs -package-db simple-plugin/pkg.plugins09/local.package.conf -fplugin Simple.SourcePlugin -fplugin-opt Simple.SourcePlugin:a -fplugin-opt Simple.SourcePlugin:b -plugin-package simple-plugin + +.PHONY: plugins10 +plugins10: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins10.hs QuasiQuotation.hs -package-db simple-plugin/pkg.plugins10/local.package.conf -fplugin Simple.SourcePlugin -plugin-package simple-plugin + +.PHONY: plugins11 +plugins11: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins11.hs -package-db simple-plugin/pkg.plugins11/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins12 +plugins12: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins12.hs -package-db simple-plugin/pkg.plugins12/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins13 +plugins13: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins13.hs PluginFilteredExport.hs -package-db simple-plugin/pkg.plugins13/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins14 +plugins14: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins14.hs -package-db simple-plugin/pkg.plugins14/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins15 +plugins15: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins15.hs MetaRemoveHelper.hs -package-db simple-plugin/pkg.plugins15/local.package.conf -plugin-package simple-plugin + # -package (should work for backwards compatibility) .PHONY: T10420 T10420: diff --git a/testsuite/tests/plugins/MetaRemoveHelper.hs b/testsuite/tests/plugins/MetaRemoveHelper.hs new file mode 100644 index 0000000000..06a67995f7 --- /dev/null +++ b/testsuite/tests/plugins/MetaRemoveHelper.hs @@ -0,0 +1,6 @@ +module MetaRemoveHelper where + +import Language.Haskell.TH + +clear :: Q [Dec] -> Q [Dec] +clear _ = return [] diff --git a/testsuite/tests/plugins/PluginFilteredExport.hs b/testsuite/tests/plugins/PluginFilteredExport.hs new file mode 100644 index 0000000000..6dd62d33ff --- /dev/null +++ b/testsuite/tests/plugins/PluginFilteredExport.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:typecheck #-} +-- testing that the plugin can alter the parsed representation +module PluginFilteredExport where + +map :: () +map = () diff --git a/testsuite/tests/plugins/QuasiQuotation.hs b/testsuite/tests/plugins/QuasiQuotation.hs new file mode 100644 index 0000000000..b8fe5d6b26 --- /dev/null +++ b/testsuite/tests/plugins/QuasiQuotation.hs @@ -0,0 +1,11 @@ +module QuasiQuotation where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +stringify :: QuasiQuoter +stringify = QuasiQuoter { quoteExp = return . LitE . StringL + , quotePat = return . LitP . StringL + , quoteType = return . LitT . StrTyLit + , quoteDec = const (return []) + } diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 94d0e2d053..34b11623ef 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -39,6 +39,42 @@ test('plugins08', pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins08 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins08']) +test('plugins09', + [extra_files(['simple-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins09 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins09']) + +test('plugins10', + [expect_broken(15216), + extra_files(['simple-plugin/', 'QuasiQuotation.hs']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins10 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins10']) + +test('plugins11', + [extra_files(['simple-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins11 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins11']) + +test('plugins12', + [extra_files(['simple-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins12 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins12']) + +test('plugins13', + [extra_files(['simple-plugin/', 'PluginFilteredExport.hs']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins13 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins13']) + +test('plugins14', + [extra_files(['simple-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins14 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins14']) + +test('plugins15', + [extra_files(['simple-plugin/', 'MetaRemoveHelper.hs']), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins15 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins15']) + test('T10420', [extra_files(['rule-defining-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T10420 TOP={top}')], diff --git a/testsuite/tests/plugins/plugins04.stderr b/testsuite/tests/plugins/plugins04.stderr index f0acc67d22..46c0f9ce55 100644 --- a/testsuite/tests/plugins/plugins04.stderr +++ b/testsuite/tests/plugins/plugins04.stderr @@ -1,2 +1,2 @@ Module imports form a cycle: - module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself + module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself
\ No newline at end of file diff --git a/testsuite/tests/plugins/plugins09.hs b/testsuite/tests/plugins/plugins09.hs new file mode 100644 index 0000000000..d843c00b78 --- /dev/null +++ b/testsuite/tests/plugins/plugins09.hs @@ -0,0 +1 @@ +module A where diff --git a/testsuite/tests/plugins/plugins09.stdout b/testsuite/tests/plugins/plugins09.stdout new file mode 100644 index 0000000000..efb740b9ab --- /dev/null +++ b/testsuite/tests/plugins/plugins09.stdout @@ -0,0 +1,8 @@ +parsePlugin(a,b) +interfacePlugin: Prelude +interfacePlugin: GHC.Float +interfacePlugin: GHC.Base +interfacePlugin: GHC.Types +typeCheckPlugin (rn) +typeCheckPlugin (tc) +interfacePlugin: GHC.Integer.Type
\ No newline at end of file diff --git a/testsuite/tests/plugins/plugins10.hs b/testsuite/tests/plugins/plugins10.hs new file mode 100644 index 0000000000..d4564a2c29 --- /dev/null +++ b/testsuite/tests/plugins/plugins10.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fplugin-opt Simple.SourcePlugin:a #-} +{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} +module B where + +import QuasiQuotation + +$(return []) + +x = [stringify|x|] diff --git a/testsuite/tests/plugins/plugins10.stdout b/testsuite/tests/plugins/plugins10.stdout new file mode 100644 index 0000000000..737789cc56 --- /dev/null +++ b/testsuite/tests/plugins/plugins10.stdout @@ -0,0 +1,18 @@ +parsePlugin() +interfacePlugin: Prelude +interfacePlugin: Language.Haskell.TH +interfacePlugin: Language.Haskell.TH.Quote +interfacePlugin: GHC.Float +interfacePlugin: GHC.Base +interfacePlugin: Language.Haskell.TH.Syntax +interfacePlugin: GHC.Types +typeCheckPlugin (rn) +typeCheckPlugin (tc) +interfacePlugin: GHC.Integer.Type +parsePlugin(a) +interfacePlugin: Language.Haskell.TH.Lib.Internal +metaPlugin: return [] +metaPlugin: quoteExp stringify "x" +interfacePlugin: GHC.CString +typeCheckPlugin (rn) +typeCheckPlugin (tc)
\ No newline at end of file diff --git a/testsuite/tests/plugins/plugins11.hs b/testsuite/tests/plugins/plugins11.hs new file mode 100644 index 0000000000..f714472a07 --- /dev/null +++ b/testsuite/tests/plugins/plugins11.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -fplugin Simple.SourcePlugin #-} +module A where diff --git a/testsuite/tests/plugins/plugins11.stdout b/testsuite/tests/plugins/plugins11.stdout new file mode 100644 index 0000000000..1e630427c1 --- /dev/null +++ b/testsuite/tests/plugins/plugins11.stdout @@ -0,0 +1,8 @@ +parsePlugin() +interfacePlugin: Prelude +interfacePlugin: GHC.Float +interfacePlugin: GHC.Base +interfacePlugin: GHC.Types +typeCheckPlugin (rn) +typeCheckPlugin (tc) +interfacePlugin: GHC.Integer.Type
\ No newline at end of file diff --git a/testsuite/tests/plugins/plugins12.hs b/testsuite/tests/plugins/plugins12.hs new file mode 100644 index 0000000000..96d35db179 --- /dev/null +++ b/testsuite/tests/plugins/plugins12.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:parse #-} +-- testing that the plugin can alter the parsed representation +module A where + +map x = () + +x = map show [1,2,3] diff --git a/testsuite/tests/plugins/plugins13.hs b/testsuite/tests/plugins/plugins13.hs new file mode 100644 index 0000000000..273aba2df9 --- /dev/null +++ b/testsuite/tests/plugins/plugins13.hs @@ -0,0 +1,5 @@ +module A where + +import PluginFilteredExport + +x = map show [1,2,3] diff --git a/testsuite/tests/plugins/plugins14.hs b/testsuite/tests/plugins/plugins14.hs new file mode 100644 index 0000000000..6f4c2f5780 --- /dev/null +++ b/testsuite/tests/plugins/plugins14.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:interface #-} +module A where +-- test if a definition can be removed from loaded interface + +map :: () +map = () + +x :: () +x = map diff --git a/testsuite/tests/plugins/plugins15.hs b/testsuite/tests/plugins/plugins15.hs new file mode 100644 index 0000000000..be760192ae --- /dev/null +++ b/testsuite/tests/plugins/plugins15.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:clear #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:meta #-} +{-# LANGUAGE TemplateHaskell #-} +-- testing that the plugin can alter the evaluated splice +module A where + +import MetaRemoveHelper + +$(clear [d| a = () |]) + +x = a diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs new file mode 100644 index 0000000000..c64b62f8a7 --- /dev/null +++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts #-} +module Simple.RemovePlugin where + +import Control.Monad.IO.Class +import Data.List (intercalate) +import Plugins +import Bag +import HscTypes +import TcRnTypes +import HsExtension +import HsExpr +import Outputable +import SrcLoc +import HsSyn +import HsBinds +import OccName +import RdrName +import Name +import Avail + +plugin :: Plugin +plugin = defaultPlugin { parsedResultAction = parsedPlugin + , typeCheckResultAction = typecheckPlugin + , spliceRunAction = metaPlugin' + , interfaceLoadAction = interfaceLoadPlugin' + } + +parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule + -> Hsc HsParsedModule +parsedPlugin [name, "parse"] _ pm + = return $ pm { hpm_module = removeParsedBinding name (hpm_module pm) } +parsedPlugin _ _ pm = return pm + +removeParsedBinding :: String -> Located (HsModule GhcPs) + -> Located (HsModule GhcPs) +removeParsedBinding name (L l m) + = (L l (m { hsmodDecls = filter (notNamedAs name) (hsmodDecls m) } )) + where notNamedAs name (L _ (ValD _ (FunBind { fun_id = L _ fid }))) + = occNameString (rdrNameOcc fid) /= name + notNamedAs _ _ = True + +typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> Hsc TcGblEnv +typecheckPlugin [name, "typecheck"] _ tc + = return $ tc { tcg_exports = filter (availNotNamedAs name) (tcg_exports tc) + , tcg_binds = filterBag (notNamedAs name) (tcg_binds tc) + } + where notNamedAs name (L _ FunBind { fun_id = L _ fid }) + = occNameString (getOccName fid) /= name + notNamedAs name (L _ AbsBinds { abs_binds = bnds }) + = all (notNamedAs name) bnds + notNamedAs _ (L _ b) = True +typecheckPlugin _ _ tc = return tc + +metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) +metaPlugin' [name, "meta"] (L _ (HsApp noExt (L l (HsVar _ (L _ id))) e)) + | occNameString (getOccName id) == name + = return e +metaPlugin' _ meta = return meta + +interfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface +interfaceLoadPlugin' [name, "interface"] iface + = return $ iface { mi_exports = filter (availNotNamedAs name) + (mi_exports iface) + } +interfaceLoadPlugin' _ iface = return iface + +availNotNamedAs :: String -> AvailInfo -> Bool +availNotNamedAs name avail + = occNameString (getOccName (availName avail)) /= name diff --git a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs new file mode 100644 index 0000000000..d5c9dd1856 --- /dev/null +++ b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs @@ -0,0 +1,52 @@ +module Simple.SourcePlugin where + +import Control.Monad.IO.Class +import Data.List (intercalate) +import Data.Maybe (isJust) +import Plugins +import HscTypes +import TcRnTypes +import HsExtension +import Avail +import HsExpr +import Outputable +import HsImpExp +import HsDecls +import HsDoc + +plugin :: Plugin +plugin = defaultPlugin { parsedResultAction = parsedPlugin + , typeCheckResultAction = typecheckPlugin + , spliceRunAction = metaPlugin' + , interfaceLoadAction = interfaceLoadPlugin' + , renamedResultAction = Just renamedAction + } + +parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule + -> Hsc HsParsedModule +parsedPlugin opts _ pm + = do liftIO $ putStrLn $ "parsePlugin(" ++ intercalate "," opts ++ ")" + return pm + +renamedAction :: [CommandLineOption] -> ModSummary + -> ( HsGroup GhcRn, [LImportDecl GhcRn] + , Maybe [(LIE GhcRn, Avails)], Maybe LHsDocString ) + -> Hsc () +renamedAction _ _ ( gr, _, _, _ ) + = liftIO $ putStrLn "typeCheckPlugin (rn)" + +typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> Hsc TcGblEnv +typecheckPlugin _ _ tc + = do liftIO $ putStrLn "typeCheckPlugin (tc)" + return tc + +metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) +metaPlugin' _ meta + = do liftIO $ putStrLn $ "metaPlugin: " ++ (showSDocUnsafe $ ppr meta) + return meta + +interfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface +interfaceLoadPlugin' _ iface + = do liftIO $ putStrLn $ "interfacePlugin: " + ++ (showSDocUnsafe $ ppr $ mi_module iface) + return iface diff --git a/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal b/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal index 011ed67e23..0a3c49e988 100644 --- a/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal +++ b/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal @@ -17,4 +17,6 @@ Library Exposed-Modules: Simple.Plugin Simple.BadlyTypedPlugin - Simple.DataStructures
\ No newline at end of file + Simple.DataStructures + Simple.SourcePlugin + Simple.RemovePlugin |