Read COMPLETE sets from external packages

Currently, `COMPLETE` pragmas are not read from external packages at
all, which quite limits their usefulness. This extends
`ExternalPackageState` to include `COMPLETE` sets from other packages,
and plumbs around the appropriate values to make it work the way you'd
expect it to.

Fixes #13350.

Test Plan: make test TEST=T13350

Reviewers: rwbarton, mpickering, austin, simonpj, bgamari

Reviewed By: simonpj

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D3257

16 files changed, 192 insertions, 66 deletions

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 4a8a18d77c..792932df5a 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -1097,11 +1097,12 @@ allCompleteMatches cl tys = do
             [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))]
            PatSynCon _    -> []
 
-
-  from_pragma <- map ((FromComplete,) . completeMatch) <$>
-                  case splitTyConApp_maybe (conLikeResTy cl tys) of
-                    Just (tc, _) -> dsGetCompleteMatches tc
-                    Nothing -> return []
+  pragmas <- case splitTyConApp_maybe (conLikeResTy cl tys) of
+              Just (tc, _) -> dsGetCompleteMatches tc
+              Nothing -> return []
+  let fams cm = fmap (FromComplete,) $
+                mapM dsLookupConLike (completeMatchConLikes cm)
+  from_pragma <- mapM fams pragmas
 
   let final_groups = fam ++ from_pragma
   tracePmD "allCompleteMatches" (ppr final_groups)
diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs
index 4f68100111..fcdf5821f1 100644
--- a/compiler/deSugar/DsMonad.hs
+++ b/compiler/deSugar/DsMonad.hs
@@ -23,7 +23,8 @@ module DsMonad (
         newUnique,
         UniqSupply, newUniqueSupply,
         getGhcModeDs, dsGetFamInstEnvs,
-        dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon,
+        dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon,
+        dsLookupDataCon, dsLookupConLike,
 
         PArrBuiltin(..),
         dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
@@ -67,6 +68,7 @@ import RdrName
 import HscTypes
 import Bag
 import DataCon
+import ConLike
 import TyCon
 import PmExpr
 import Id
@@ -543,6 +545,10 @@ dsLookupDataCon :: Name -> DsM DataCon
 dsLookupDataCon name
   = tyThingDataCon <$> dsLookupGlobal name
 
+dsLookupConLike :: Name -> DsM ConLike
+dsLookupConLike name
+  = tyThingConLike <$> dsLookupGlobal name
+
 -- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
 --  Panic if there isn't one, or if it is defined multiple times.
 dsLookupDPHRdrEnv :: OccName -> DsM Name
@@ -619,8 +625,12 @@ dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) }
 -- | The @COMPLETE@ pragams provided by the user for a given `TyCon`.
 dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch]
 dsGetCompleteMatches tc = do
+  eps <- getEps
   env <- getGblEnv
-  return $ (lookupWithDefaultUFM (ds_complete_matches env) [] tc)
+  let lookup_completes ufm = lookupWithDefaultUFM ufm [] tc
+      eps_matches_list = lookup_completes $ eps_complete_matches eps
+      env_matches_list = lookup_completes $ ds_complete_matches env
+  return $ eps_matches_list ++ env_matches_list
 
 dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
 dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) }
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 0edf5d9794..a3f77614f9 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -33,7 +33,8 @@ module LoadIface (
 #include "HsVersions.h"
 
 import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
-                                 tcIfaceFamInst, tcIfaceVectInfo, tcIfaceAnnotations )
+                                 tcIfaceFamInst, tcIfaceVectInfo,
+                                 tcIfaceAnnotations, tcIfaceCompleteSigs )
 
 import DynFlags
 import IfaceSyn
@@ -462,6 +463,7 @@ loadInterface doc_str mod from
         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
         ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
         ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface)
+        ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
 
         ; let { final_iface = iface {
                                 mi_decls     = panic "No mi_decls in PIT",
@@ -480,6 +482,10 @@ loadInterface doc_str mod from
                   eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
                   eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
                                                         new_eps_rules,
+                  eps_complete_matches
+                                   = extendCompleteMatchMap
+                                         (eps_complete_matches eps)
+                                         new_eps_complete_sigs,
                   eps_inst_env     = extendInstEnvList (eps_inst_env eps)
                                                        new_eps_insts,
                   eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
@@ -910,18 +916,19 @@ readIface wanted_mod file_path
 initExternalPackageState :: ExternalPackageState
 initExternalPackageState
   = EPS {
-      eps_is_boot      = emptyUFM,
-      eps_PIT          = emptyPackageIfaceTable,
-      eps_free_holes   = emptyInstalledModuleEnv,
-      eps_PTE          = emptyTypeEnv,
-      eps_inst_env     = emptyInstEnv,
-      eps_fam_inst_env = emptyFamInstEnv,
-      eps_rule_base    = mkRuleBase builtinRules,
+      eps_is_boot          = emptyUFM,
+      eps_PIT              = emptyPackageIfaceTable,
+      eps_free_holes       = emptyInstalledModuleEnv,
+      eps_PTE              = emptyTypeEnv,
+      eps_inst_env         = emptyInstEnv,
+      eps_fam_inst_env     = emptyFamInstEnv,
+      eps_rule_base        = mkRuleBase builtinRules,
         -- Initialise the EPS rule pool with the built-in rules
       eps_mod_fam_inst_env
-                       = emptyModuleEnv,
-      eps_vect_info    = noVectInfo,
-      eps_ann_env      = emptyAnnEnv,
+                           = emptyModuleEnv,
+      eps_vect_info        = noVectInfo,
+      eps_complete_matches = emptyUFM,
+      eps_ann_env          = emptyAnnEnv,
       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
                            , n_insts_in = 0, n_insts_out = 0
                            , n_rules_in = length builtinRules, n_rules_out = 0 }
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 7974c983d1..a3418860b5 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1001,8 +1001,7 @@ mkOrphMap get_key decls
 -}
 
 mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch
-mkIfaceCompleteSig (CompleteMatch cls tc) =
-  IfaceCompleteMatch (map conLikeName cls) (tyConName tc)
+mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc
 
 
 {-
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 2a56392910..2d30f52b8a 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -15,7 +15,7 @@ module TcIface (
         typecheckIfacesForMerging,
         typecheckIfaceForInstantiate,
         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
-        tcIfaceVectInfo, tcIfaceAnnotations,
+        tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceCompleteSigs,
         tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)
         tcIfaceGlobal
  ) where
@@ -1096,9 +1096,7 @@ tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
 tcIfaceCompleteSigs = mapM tcIfaceCompleteSig
 
 tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch
-tcIfaceCompleteSig cm@(IfaceCompleteMatch ms t) =
-  forkM (text "COMPLETE" <+> ppr cm) $
-    CompleteMatch <$> mapM tcIfaceConLike ms <*> tcIfaceTyConByName t
+tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t)
 
 {-
 ************************************************************************
@@ -1760,14 +1758,6 @@ tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
                                 AConLike (RealDataCon dc) -> return dc
                                 _       -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
 
-tcIfaceConLike :: Name -> IfL ConLike
-tcIfaceConLike name =
-    do { thing <- tcIfaceGlobal name
-       ; case thing of
-        AConLike cl -> return cl
-        _           -> pprPanic "tcIfaceExtCL" (ppr name$$ ppr thing) }
-
-
 tcIfaceExtId :: Name -> IfL Id
 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
                        ; case thing of
diff --git a/compiler/iface/TcIface.hs-boot b/compiler/iface/TcIface.hs-boot
index 9c1b16b520..4a99114fc0 100644
--- a/compiler/iface/TcIface.hs-boot
+++ b/compiler/iface/TcIface.hs-boot
@@ -1,18 +1,20 @@
 module TcIface where
 
-import IfaceSyn    ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule, IfaceAnnotation )
+import IfaceSyn    ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule,
+                     IfaceAnnotation, IfaceCompleteMatch )
 import TyCoRep     ( TyThing )
 import TcRnTypes   ( IfL )
 import InstEnv     ( ClsInst )
 import FamInstEnv  ( FamInst )
 import CoreSyn     ( CoreRule )
-import HscTypes    ( TypeEnv, VectInfo, IfaceVectInfo )
+import HscTypes    ( TypeEnv, VectInfo, IfaceVectInfo, CompleteMatch )
 import Module      ( Module )
 import Annotations ( Annotation )
 
-tcIfaceDecl        :: Bool -> IfaceDecl -> IfL TyThing
-tcIfaceRules       :: Bool -> [IfaceRule] -> IfL [CoreRule]
-tcIfaceVectInfo    :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
-tcIfaceInst        :: IfaceClsInst -> IfL ClsInst
-tcIfaceFamInst     :: IfaceFamInst -> IfL FamInst
-tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
+tcIfaceDecl         :: Bool -> IfaceDecl -> IfL TyThing
+tcIfaceRules        :: Bool -> [IfaceRule] -> IfL [CoreRule]
+tcIfaceVectInfo     :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
+tcIfaceInst         :: IfaceClsInst -> IfL ClsInst
+tcIfaceFamInst      :: IfaceFamInst -> IfL FamInst
+tcIfaceAnnotations  :: [IfaceAnnotation] -> IfL [Annotation]
+tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 6473512411..793839a510 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -47,6 +47,7 @@ module HscTypes (
         lookupIfaceByModule, emptyModIface, lookupHptByModule,
 
         PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
+        PackageCompleteMatchMap,
 
         mkSOName, mkHsSOName, soExt,
 
@@ -81,7 +82,7 @@ module HscTypes (
 
         -- * TyThings and type environments
         TyThing(..),  tyThingAvailInfo,
-        tyThingTyCon, tyThingDataCon,
+        tyThingTyCon, tyThingDataCon, tyThingConLike,
         tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyCoVars,
         implicitTyThings, implicitTyConThings, implicitClassThings,
         isImplicitTyThing,
@@ -134,7 +135,8 @@ module HscTypes (
         handleFlagWarnings, printOrThrowWarnings,
 
         -- * COMPLETE signature
-        CompleteMatch(..)
+        CompleteMatch(..), CompleteMatchMap,
+        mkCompleteMatchMap, extendCompleteMatchMap
     ) where
 
 #include "HsVersions.h"
@@ -2089,6 +2091,12 @@ tyThingDataCon :: TyThing -> DataCon
 tyThingDataCon (AConLike (RealDataCon dc)) = dc
 tyThingDataCon other                       = pprPanic "tyThingDataCon" (ppr other)
 
+-- | Get the 'ConLike' from a 'TyThing' if it is a data constructor thing.
+-- Panics otherwise
+tyThingConLike :: TyThing -> ConLike
+tyThingConLike (AConLike dc) = dc
+tyThingConLike other         = pprPanic "tyThingConLike" (ppr other)
+
 -- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
 tyThingId :: TyThing -> Id
 tyThingId (AnId id)                   = id
@@ -2427,12 +2435,13 @@ instance Binary Usage where
 ************************************************************************
 -}
 
-type PackageTypeEnv    = TypeEnv
-type PackageRuleBase   = RuleBase
-type PackageInstEnv    = InstEnv
-type PackageFamInstEnv = FamInstEnv
-type PackageVectInfo   = VectInfo
-type PackageAnnEnv     = AnnEnv
+type PackageTypeEnv          = TypeEnv
+type PackageRuleBase         = RuleBase
+type PackageInstEnv          = InstEnv
+type PackageFamInstEnv       = FamInstEnv
+type PackageVectInfo         = VectInfo
+type PackageAnnEnv           = AnnEnv
+type PackageCompleteMatchMap = CompleteMatchMap
 
 -- | Information about other packages that we have slurped in by reading
 -- their interface files
@@ -2496,6 +2505,9 @@ data ExternalPackageState
                                                -- from all the external-package modules
         eps_ann_env      :: !PackageAnnEnv,    -- ^ The total 'AnnEnv' accumulated
                                                -- from all the external-package modules
+        eps_complete_matches :: !PackageCompleteMatchMap,
+                                  -- ^ The total 'CompleteMatchMap' accumulated
+                                  -- from all the external-package modules
 
         eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external
                                                          -- packages, keyed off the module that declared them
@@ -3008,11 +3020,78 @@ byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)
 
 -- | A list of conlikes which represents a complete pattern match.
 -- These arise from @COMPLETE@ signatures.
+
+-- See Note [Implementation of COMPLETE signatures]
 data CompleteMatch = CompleteMatch {
-                          completeMatch :: [ConLike]
-                          , completeMatchType :: TyCon
+                            completeMatchConLikes :: [Name]
+                            -- ^ The ConLikes that form a covering family
+                            -- (e.g. Nothing, Just)
+                          , completeMatchTyCon :: Name
+                            -- ^ The TyCon that they cover (e.g. Maybe)
                           }
 
 instance Outputable CompleteMatch where
   ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl
-                                                   <+>  dcolon <+> ppr ty
+                                                    <+> dcolon <+> ppr ty
+
+-- | A map keyed by the 'completeMatchTyCon'.
+
+-- See Note [Implementation of COMPLETE signatures]
+type CompleteMatchMap = UniqFM [CompleteMatch]
+
+mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap
+mkCompleteMatchMap = extendCompleteMatchMap emptyUFM
+
+extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch]
+                       -> CompleteMatchMap
+extendCompleteMatchMap = foldl' insertMatch
+  where
+    insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap
+    insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c]
+
+{-
+Note [Implementation of COMPLETE signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A COMPLETE signature represents a set of conlikes (i.e., constructors or
+pattern synonyms) such that if they are all pattern-matched against in a
+function, it gives rise to a total function. An example is:
+
+  newtype Boolean = Boolean Int
+  pattern F, T :: Boolean
+  pattern F = Boolean 0
+  pattern T = Boolean 1
+  {-# COMPLETE F, T #-}
+
+  -- This is a total function
+  booleanToInt :: Boolean -> Int
+  booleanToInt F = 0
+  booleanToInt T = 1
+
+COMPLETE sets are represented internally in GHC with the CompleteMatch data
+type. For example, {-# COMPLETE F, T #-} would be represented as:
+
+  CompleteMatch { complateMatchConLikes = [F, T]
+                , completeMatchTyCon    = Boolean }
+
+Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the
+cases in which it's ambiguous, you can also explicitly specify it in the source
+language by writing this:
+
+  {-# COMPLETE F, T :: Boolean #-}
+
+For efficiency purposes, GHC collects all of the CompleteMatches that it knows
+about into a CompleteMatchMap, which is a map that is keyed by the
+completeMatchTyCon. In other words, you could have a multiple COMPLETE sets
+for the same TyCon:
+
+  {-# COMPLETE F, T1 :: Boolean #-}
+  {-# COMPLETE F, T2 :: Boolean #-}
+
+And looking up the values in the CompleteMatchMap associated with Boolean
+would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean].
+dsGetCompleteMatches in DsMeta accomplishes this lookup.
+
+Also see Note [Typechecking Complete Matches] in TcBinds for a more detailed
+explanation for how GHC ensures that all the conlikes in a COMPLETE set are
+consistent.
+-}
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index bb20b43892..201da00504 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -245,12 +245,18 @@ tcCompleteSigs sigs =
             (res, cls) <- checkCLTypes AcceptAny
             case res of
               AcceptAny -> failWithTc ambiguousError
-              Fixed _ tc  -> return $ CompleteMatch cls tc
+              Fixed _ tc  -> return $ mkMatch cls tc
 
           check_complete_match tc_name = do
             ty_con <- tcLookupLocatedTyCon tc_name
             (_, cls) <- checkCLTypes (Fixed Nothing ty_con)
-            return $ CompleteMatch cls ty_con
+            return $ mkMatch cls ty_con
+
+          mkMatch :: [ConLike] -> TyCon -> CompleteMatch
+          mkMatch cls ty_con = CompleteMatch {
+            completeMatchConLikes = map conLikeName cls,
+            completeMatchTyCon = tyConName ty_con
+            }
       doOne _ = return Nothing
 
       ambiguousError :: SDoc
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 8e526bc5b3..1adf16058a 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -47,7 +47,8 @@ module TcRnTypes(
 
         -- Desugaring types
         DsM, DsLclEnv(..), DsGblEnv(..), PArrBuiltin(..),
-        DsMetaEnv, DsMetaVal(..), CompleteMatchMap, mkCompleteMatchMap,
+        DsMetaEnv, DsMetaVal(..), CompleteMatchMap,
+        mkCompleteMatchMap, extendCompleteMatchMap,
 
         -- Template Haskell
         ThStage(..), SpliceType(..), PendingStuff(..),
@@ -174,7 +175,6 @@ import FastString
 import qualified GHC.LanguageExtensions as LangExt
 import Fingerprint
 import Util
-import UniqFM ( emptyUFM, addToUFM_C, UniqFM )
 
 import Control.Monad (ap, liftM, msum)
 #if __GLASGOW_HASKELL__ > 710
@@ -189,8 +189,6 @@ import Data.Typeable ( TypeRep )
 import GHCi.Message
 import GHCi.RemoteTypes
 
-import Data.List (foldl')
-
 import qualified Language.Haskell.TH as TH
 
 -- | A 'NameShape' is a substitution on 'Name's that can be used
@@ -384,14 +382,6 @@ data DsGblEnv
            -- Additional complete pattern matches
         }
 
-type CompleteMatchMap = UniqFM [CompleteMatch]
-
-mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap
-mkCompleteMatchMap cms = foldl' insertMatch emptyUFM cms
-  where
-    insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap
-    insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c]
-
 instance ContainsModule DsGblEnv where
     extractModule = ds_mod
 
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index a1ccee3ae7..9d385d23ea 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -674,7 +674,6 @@ instance Binary KindRep where
     put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b
     put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r
     put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh r
-    put_ _  _ = fail "Binary.putKindRep: impossible"
 
     get bh = do
         tag <- getByte bh
diff --git a/testsuite/tests/patsyn/should_compile/T13350/Makefile b/testsuite/tests/patsyn/should_compile/T13350/Makefile
new file mode 100644
index 0000000000..ffd584a2a3
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13350/Makefile
@@ -0,0 +1,13 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+LOCAL_PKGCONF=local.package.conf
+
+T13350:
+	"$(GHC_PKG)" init $(LOCAL_PKGCONF)
+	cd boolean && "$(TEST_HC)" -v0 --make Setup.hs
+	cd boolean && ./Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
+	cd boolean && ./Setup build -v0
+	cd boolean && ./Setup register -v0 --inplace
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c T13350.hs -package-db $(LOCAL_PKGCONF)
diff --git a/testsuite/tests/patsyn/should_compile/T13350/T13350.hs b/testsuite/tests/patsyn/should_compile/T13350/T13350.hs
new file mode 100644
index 0000000000..986c4f2462
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13350/T13350.hs
@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+module T13350 where
+
+import Boolean
+
+booleanToInt :: Boolean -> Int
+booleanToInt F = 0
+booleanToInt T = 1
diff --git a/testsuite/tests/patsyn/should_compile/T13350/all.T b/testsuite/tests/patsyn/should_compile/T13350/all.T
new file mode 100644
index 0000000000..fa63e37c6f
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13350/all.T
@@ -0,0 +1,4 @@
+# Test that importing COMPLETE sets from external packages works
+
+test('T13350', extra_files(['T13350.hs', 'boolean']), run_command,
+     ['$MAKE -s --no-print-directory T13350'])
diff --git a/testsuite/tests/patsyn/should_compile/T13350/boolean/Boolean.hs b/testsuite/tests/patsyn/should_compile/T13350/boolean/Boolean.hs
new file mode 100644
index 0000000000..181641dbad
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13350/boolean/Boolean.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Boolean (Boolean, pattern F, pattern T) where
+
+newtype Boolean = Boolean Int
+
+pattern F, T :: Boolean
+pattern F = Boolean 0
+pattern T = Boolean 1
+{-# COMPLETE F, T #-}
diff --git a/testsuite/tests/patsyn/should_compile/T13350/boolean/Setup.hs b/testsuite/tests/patsyn/should_compile/T13350/boolean/Setup.hs
new file mode 100644
index 0000000000..9a994af677
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13350/boolean/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/patsyn/should_compile/T13350/boolean/boolean.cabal b/testsuite/tests/patsyn/should_compile/T13350/boolean/boolean.cabal
new file mode 100644
index 0000000000..0e1f308ce6
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13350/boolean/boolean.cabal
@@ -0,0 +1,7 @@
+name: boolean
+version: 1.0
+build-type: Simple
+
+library
+  build-depends:   base
+  exposed-modules: Boolean