From fd7ea0fee92a60f9658254cc4fe3abdb4ff299b1 Mon Sep 17 00:00:00 2001
From: Sebastian Graf <sebastian.graf@kit.edu>
Date: Tue, 14 Apr 2020 13:58:25 +0200
Subject: PmCheck: Pick up `EvVar`s bound in `HsWrapper`s for long-distance
 info

`HsWrapper`s introduce evidence bindings through `WpEvLam` which the
pattern-match coverage checker should be made aware of.

Failing to do so caused #18049, where the resulting impreciseness of
imcompleteness warnings seemingly contradicted with
`-Winaccessible-code`.

The solution is simple: Collect all the evidence binders of an
`HsWrapper` and add it to the ambient `Deltas` before desugaring
the wrapped expression.

But that means we pick up many more evidence bindings, even when they
wrap around code without a single pattern match to check! That regressed
`T3064` by over 300%, so now we are adding long-distance info lazily
through judicious use of `unsafeInterleaveIO`.

Fixes #18049.
---
 testsuite/tests/pmcheck/should_compile/T18049.hs | 29 ++++++++++++++++++++++++
 testsuite/tests/pmcheck/should_compile/all.T     |  2 ++
 2 files changed, 31 insertions(+)
 create mode 100644 testsuite/tests/pmcheck/should_compile/T18049.hs

(limited to 'testsuite')

diff --git a/testsuite/tests/pmcheck/should_compile/T18049.hs b/testsuite/tests/pmcheck/should_compile/T18049.hs
new file mode 100644
index 0000000000..b63ffdf751
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18049.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+module Bug where
+
+import Data.Kind
+
+data SBool :: Bool -> Type where
+  SFalse :: SBool False
+  STrue  :: SBool True
+
+f :: SBool b
+  -> (b ~ True  => SBool b -> r)
+  -> (b ~ False => SBool b -> r)
+  -> r
+f x t f =
+  case x of
+    SFalse -> f x
+    STrue  -> t x
+
+g :: forall b. SBool b -> ()
+g x = f x
+  (\x' ->
+    case x' of
+      -- SFalse -> ()
+      STrue  -> ())
+  (\_ -> ())
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index 0c3bfcf510..2e4e3942ac 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -118,6 +118,8 @@ test('T17977', collect_compiler_stats('bytes allocated',10), compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T17977b', collect_compiler_stats('bytes allocated',10), compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T18049', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 
 # Other tests
 test('pmc001', [], compile,
-- 
cgit v1.2.1