diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-05-29 12:48:50 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-05-31 02:01:18 -0400 |
| commit | e32786dfc9290e037f70cd942d5922217f2ab7cc (patch) | |
| tree | 1091f076514d1aa34478b5ffa0e448c8fb36a86d | |
| parent | bb929009523a20271e1af34990e5c85d440de0d7 (diff) | |
| download | haskell-e32786dfc9290e037f70cd942d5922217f2ab7cc.tar.gz | |
Put COMPLETE sigs into ModDetails with -fno-code (#16682)
`mkBootModDetailsTc`, which creates a special `ModDetails` when
`-fno-code` is enabled, was not properly filling in the `COMPLETE`
signatures from the `TcGblEnv`, resulting in incorrect pattern-match
coverage warnings. Easily fixed.
Fixes #16682.
| -rw-r--r-- | compiler/main/TidyPgm.hs | 29 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_compile/T16682.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_compile/T16682a.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_compile/all.T | 2 |
4 files changed, 30 insertions, 14 deletions
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index ba9cd79e3d..d0e813a403 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -135,13 +135,14 @@ Plan A: mkBootModDetails: omit pragmas, make interfaces small mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails mkBootModDetailsTc hsc_env - TcGblEnv{ tcg_exports = exports, - tcg_type_env = type_env, -- just for the Ids - tcg_tcs = tcs, - tcg_patsyns = pat_syns, - tcg_insts = insts, - tcg_fam_insts = fam_insts, - tcg_mod = this_mod + TcGblEnv{ tcg_exports = exports, + tcg_type_env = type_env, -- just for the Ids + tcg_tcs = tcs, + tcg_patsyns = pat_syns, + tcg_insts = insts, + tcg_fam_insts = fam_insts, + tcg_complete_matches = complete_sigs, + tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but -- the message is useful to locating oneself in the compilation process. @@ -156,13 +157,13 @@ mkBootModDetailsTc hsc_env ; dfun_ids = map instanceDFunId insts' ; type_env' = extendTypeEnvWithIds type_env2 dfun_ids } - ; return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = [] + ; return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_sigs = complete_sigs }) } where diff --git a/testsuite/tests/patsyn/should_compile/T16682.hs b/testsuite/tests/patsyn/should_compile/T16682.hs new file mode 100644 index 0000000000..1a8e540f99 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T16682.hs @@ -0,0 +1,5 @@ +module T16682 where + +import T16682a + +f Unit = () -- Non-exhaustive patterns warning with -fno-code diff --git a/testsuite/tests/patsyn/should_compile/T16682a.hs b/testsuite/tests/patsyn/should_compile/T16682a.hs new file mode 100644 index 0000000000..f77bd8203a --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T16682a.hs @@ -0,0 +1,8 @@ +{-# language PatternSynonyms #-} +module T16682a where + +pattern Unit = () + +{-# complete Unit #-} + +f Unit = () -- No warnings diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 6eb9e2db8a..2ac343f635 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -77,3 +77,5 @@ test('T14326', normal, compile, ['']) test('T14394', normal, ghci_script, ['T14394.script']) test('T14552', normal, compile, ['']) test('T14498', normal, compile, ['']) +test('T16682', [extra_files(['T16682.hs', 'T16682a.hs'])], + multimod_compile, ['T16682', '-v0 -fwarn-incomplete-patterns -fno-code']) |