diff options
author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-06-03 14:33:05 -0700 |
---|---|---|
committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-06-20 15:13:42 -0700 |
commit | 0cb1f5cf26fae946ca745abc5e302e62a8f66feb (patch) | |
tree | 07744de6d51cea9bde926d3ea88c1fda2b138974 /testsuite | |
parent | 85d539754ac07286ef5fed714ad42451bd5a1d28 (diff) | |
download | haskell-0cb1f5cf26fae946ca745abc5e302e62a8f66feb.tar.gz |
Filter orphan rules based on imports, fixes #10294 and #10420.
Summary:
If we have an orphan rule in our database, don't apply it
unless the defining module is transitively imported by the
module we are processing. We do this by defining a new RuleEnv
data type which includes both the RuleBase as well as the set
of visible orphan modules, and threading this through the
relevant environments (CoreReader, RuleCheckEnv and ScEnv).
This is analogous to the instances fix we applied in #2182
4c834fdddf4d44d12039da4d6a2c63a660975b95, but done for RULES.
An important knock-on effect is that we can remove some buggy
code in LoadInterface which tried to avoid loading interfaces
that were loaded by plugins (which sometimes caused instances
and rules to NEVER become visible).
One note about tests: I renamed the old plugins07 test to T10420
and replaced plugins07 with a test to ensure that a plugin
import did not cause new rules to be loaded in.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate
Reviewers: simonpj, austin, goldfire
Subscribers: bgamari, thomie
Differential Revision: https://phabricator.haskell.org/D950
GHC Trac Issues: #10420
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/.gitignore | 4 | ||||
-rw-r--r-- | testsuite/tests/plugins/Makefile | 19 | ||||
-rw-r--r-- | testsuite/tests/plugins/T10294.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/plugins/T10294.stderr | 1 | ||||
-rw-r--r-- | testsuite/tests/plugins/T10294a.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/plugins/T10420.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/plugins/T10420.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/plugins/T10420a.hs (renamed from testsuite/tests/plugins/Plugins07a.hs) | 2 | ||||
-rw-r--r-- | testsuite/tests/plugins/all.T | 21 | ||||
-rw-r--r-- | testsuite/tests/plugins/annotation-plugin/LICENSE | 0 | ||||
-rw-r--r-- | testsuite/tests/plugins/annotation-plugin/Makefile | 18 | ||||
-rw-r--r-- | testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs | 34 | ||||
-rw-r--r-- | testsuite/tests/plugins/annotation-plugin/Setup.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal | 11 | ||||
-rw-r--r-- | testsuite/tests/plugins/plugins07.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/plugins/plugins07.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T8848.stderr | 10 |
17 files changed, 137 insertions, 16 deletions
diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 21c5709c45..10b1bfe699 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1202,7 +1202,11 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk /tests/plugins/simple-plugin/pkg.plugins02/ /tests/plugins/simple-plugin/pkg.plugins03/ /tests/plugins/simple-plugin/setup +/tests/plugins/rule-defining-plugin/pkg.T10420/ /tests/plugins/rule-defining-plugin/pkg.plugins07/ +/tests/plugins/annotation-plugin/pkg.T10294/ +/tests/plugins/annotation-plugin/pkg.T10294a/ +/tests/plugins/T10420 /tests/polykinds/Freeman /tests/polykinds/MonoidsFD /tests/polykinds/MonoidsTF diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index aac3b1257d..42a4d1af0a 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -2,12 +2,25 @@ TOP=../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: plugins01 plugins07 - +.PHONY: plugins01 plugins01: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -package simple-plugin ./plugins01 +.PHONY: plugins07 plugins07: - "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -package rule-defining-plugin + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -package rule-defining-plugin -fplugin=RuleDefiningPlugin ./plugins07 + +.PHONY: T10420 +T10420: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O T10420.hs -package-db rule-defining-plugin/pkg.T10420/local.package.conf -package rule-defining-plugin + ./T10420 + +.PHONY: T10294 +T10294: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -c -v0 T10294.hs -package-db annotation-plugin/pkg.T10294/local.package.conf -package annotation-plugin -fplugin=SayAnnNames + +.PHONY: T10294a +T10294a: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -c -v0 T10294a.hs -package-db annotation-plugin/pkg.T10294a/local.package.conf -package annotation-plugin -fplugin=SayAnnNames diff --git a/testsuite/tests/plugins/T10294.hs b/testsuite/tests/plugins/T10294.hs new file mode 100644 index 0000000000..ff1dd57400 --- /dev/null +++ b/testsuite/tests/plugins/T10294.hs @@ -0,0 +1,7 @@ +module T10294 where + +import SayAnnNames + +{-# ANN foo SomeAnn #-} +foo :: () +foo = () diff --git a/testsuite/tests/plugins/T10294.stderr b/testsuite/tests/plugins/T10294.stderr new file mode 100644 index 0000000000..4b3737a028 --- /dev/null +++ b/testsuite/tests/plugins/T10294.stderr @@ -0,0 +1 @@ +Annotated binding found: foo diff --git a/testsuite/tests/plugins/T10294a.hs b/testsuite/tests/plugins/T10294a.hs new file mode 100644 index 0000000000..ba5942be72 --- /dev/null +++ b/testsuite/tests/plugins/T10294a.hs @@ -0,0 +1,7 @@ +module T10294a where + +import SayAnnNames +import Data.Data + +baz :: Constr +baz = toConstr SomeAnn diff --git a/testsuite/tests/plugins/T10420.hs b/testsuite/tests/plugins/T10420.hs new file mode 100644 index 0000000000..7b863445ec --- /dev/null +++ b/testsuite/tests/plugins/T10420.hs @@ -0,0 +1,10 @@ +module Main where + +import T10420a + +import RuleDefiningPlugin + +{-# NOINLINE x #-} +x = "foo" + +main = putStrLn (show x) diff --git a/testsuite/tests/plugins/T10420.stdout b/testsuite/tests/plugins/T10420.stdout new file mode 100644 index 0000000000..d27268d74f --- /dev/null +++ b/testsuite/tests/plugins/T10420.stdout @@ -0,0 +1 @@ +SHOWED diff --git a/testsuite/tests/plugins/Plugins07a.hs b/testsuite/tests/plugins/T10420a.hs index 7453a31dea..da4d3b51a0 100644 --- a/testsuite/tests/plugins/Plugins07a.hs +++ b/testsuite/tests/plugins/T10420a.hs @@ -1,2 +1,2 @@ {-# OPTIONS_GHC -fplugin RuleDefiningPlugin #-} -module Plugins07a where +module T10420a where diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index e39c049dfa..62e69239b4 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -40,7 +40,24 @@ test('plugins06', test('plugins07', [pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.plugins07'), - clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.plugins07'), - expect_broken(10420)], + clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.plugins07')], run_command, ['$MAKE -s --no-print-directory plugins07']) + +test('T10420', + [pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T10420'), + clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.T10420')], + run_command, + ['$MAKE -s --no-print-directory T10420']) + +test('T10294', + [pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294'), + clean_cmd('$MAKE -s --no-print-directory -C annotation-plugin clean.T10294')], + run_command, + ['$MAKE -s --no-print-directory T10294']) + +test('T10294a', + [pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294a'), + clean_cmd('$MAKE -s --no-print-directory -C annotation-plugin clean.T10294a')], + run_command, + ['$MAKE -s --no-print-directory T10294a']) diff --git a/testsuite/tests/plugins/annotation-plugin/LICENSE b/testsuite/tests/plugins/annotation-plugin/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/plugins/annotation-plugin/LICENSE diff --git a/testsuite/tests/plugins/annotation-plugin/Makefile b/testsuite/tests/plugins/annotation-plugin/Makefile new file mode 100644 index 0000000000..7d957d0e95 --- /dev/null +++ b/testsuite/tests/plugins/annotation-plugin/Makefile @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + "$(GHC_PKG)" init pkg.$*/local.package.conf + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs new file mode 100644 index 0000000000..883ba3ada6 --- /dev/null +++ b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module SayAnnNames (plugin, SomeAnn(..)) where +import GhcPlugins +import Control.Monad (unless) +import Data.Data + +data SomeAnn = SomeAnn deriving (Data, Typeable) + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install + } + +install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] +install _ todo = do + reinitializeGlobals + return (CoreDoPluginPass "Say name" pass : todo) + +pass :: ModGuts -> CoreM ModGuts +pass g = do + dflags <- getDynFlags + mapM_ (printAnn dflags g) (mg_binds g) >> return g + where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind + printAnn dflags guts bndr@(NonRec b _) = do + anns <- annotationsOn guts b :: CoreM [SomeAnn] + unless (null anns) $ putMsgS $ + "Annotated binding found: " ++ showSDoc dflags (ppr b) + return bndr + printAnn _ _ bndr = return bndr + +annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a] +annotationsOn guts bndr = do + anns <- getAnnotations deserializeWithData guts + return $ lookupWithDefaultUFM anns [] (varUnique bndr) diff --git a/testsuite/tests/plugins/annotation-plugin/Setup.hs b/testsuite/tests/plugins/annotation-plugin/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/plugins/annotation-plugin/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal b/testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal new file mode 100644 index 0000000000..e83c0aa617 --- /dev/null +++ b/testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal @@ -0,0 +1,11 @@ +name: annotation-plugin +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: SayAnnNames + other-extensions: DeriveDataTypeable + build-depends: base >=4.8 && <4.9, ghc + default-language: Haskell2010 diff --git a/testsuite/tests/plugins/plugins07.hs b/testsuite/tests/plugins/plugins07.hs index 78762a3fd1..ddc2c53322 100644 --- a/testsuite/tests/plugins/plugins07.hs +++ b/testsuite/tests/plugins/plugins07.hs @@ -1,9 +1,5 @@ module Main where -import Plugins07a - -import RuleDefiningPlugin - {-# NOINLINE x #-} x = "foo" diff --git a/testsuite/tests/plugins/plugins07.stdout b/testsuite/tests/plugins/plugins07.stdout index d27268d74f..810c96eeeb 100644 --- a/testsuite/tests/plugins/plugins07.stdout +++ b/testsuite/tests/plugins/plugins07.stdout @@ -1 +1 @@ -SHOWED +"foo" diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr index 4cb138537b..5bdd0076ce 100644 --- a/testsuite/tests/simplCore/should_compile/T8848.stderr +++ b/testsuite/tests/simplCore/should_compile/T8848.stderr @@ -59,18 +59,18 @@ Rule fired: SPEC $c*> @ 'Z Rule fired: SPEC $fApplicativeShape @ 'Z Rule fired: SPEC $fApplicativeShape @ 'Z Rule fired: Class op $p1Applicative -Rule fired: Class op fmap +Rule fired: Class op <$ Rule fired: Class op <*> -Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape ('S 'Z)) Rule fired: Class op $p1Applicative -Rule fired: Class op fmap +Rule fired: Class op <$ Rule fired: Class op <*> Rule fired: SPEC $fApplicativeShape @ 'Z Rule fired: Class op $p1Applicative -Rule fired: Class op <$ +Rule fired: Class op fmap Rule fired: Class op <*> +Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape ('S 'Z)) Rule fired: Class op $p1Applicative -Rule fired: Class op <$ +Rule fired: Class op fmap Rule fired: Class op <*> Rule fired: SPEC $fFunctorShape @ 'Z Rule fired: Class op fmap |