[commit: ghc] master: Fix #16385 by appending _maybe to a use of lookupGlobalOcc (78dd04f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/78dd04f9126dc5df966070b8db4b39a517a9d99f/ghc

>---------------------------------------------------------------

commit 78dd04f9126dc5df966070b8db4b39a517a9d99f
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Mar 4 09:52:14 2019 -0500

    Fix #16385 by appending _maybe to a use of lookupGlobalOcc
    
    `instance forall c. c` claimed that `c` was out of scope because the
    renamer was invoking `lookupGlobalOcc` on `c` (in
    `RnNames.getLocalNonValBinders`) without binding `c` first. To avoid
    this, this patch changes GHC to invoke `lookupGlobalOcc_maybe` on `c`
    instead, and if that returns `Nothing`, then bail out, resulting
    in a better error message.


>---------------------------------------------------------------

78dd04f9126dc5df966070b8db4b39a517a9d99f
 compiler/rename/RnNames.hs                       | 32 ++++++++++++++++++------
 testsuite/tests/rename/should_fail/T16385.hs     |  5 ++++
 testsuite/tests/rename/should_fail/T16385.stderr |  8 ++++++
 testsuite/tests/rename/should_fail/all.T         |  1 +
 4 files changed, 38 insertions(+), 8 deletions(-)

diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 09fa815..08f1007 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -733,14 +733,30 @@ getLocalNonValBinders fixity_env
            ; return ([avail], flds) }
     new_assoc overload_ok (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty
                                                       , cid_datafam_insts = adts })))
-      | Just (L loc cls_rdr) <- getLHsInstDeclClass_maybe inst_ty
-      = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
-           ; (avails, fldss)
-                    <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
-           ; return (avails, concat fldss) }
-      | otherwise
-      = return ([], [])    -- Do not crash on ill-formed instances
-                           -- Eg   instance !Show Int   Trac #3811c
+      = do -- First, attempt to grab the name of the class from the instance.
+           -- This step could fail if the instance is not headed by a class,
+           -- such as in the following examples:
+           --
+           -- (1) The class is headed by a bang pattern, such as in
+           --     `instance !Show Int` (Trac #3811c)
+           -- (2) The class is headed by a type variable, such as in
+           --     `instance c` (Trac #16385)
+           --
+           -- If looking up the class name fails, then mb_cls_nm will
+           -- be Nothing.
+           mb_cls_nm <- runMaybeT $ do
+             -- See (1) above
+             L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe inst_ty
+             -- See (2) above
+             MaybeT $ setSrcSpan loc $ lookupGlobalOccRn_maybe cls_rdr
+           -- Assuming the previous step succeeded, process any associated data
+           -- family instances. If the previous step failed, bail out.
+           case mb_cls_nm of
+             Nothing -> pure ([], [])
+             Just cls_nm -> do
+               (avails, fldss)
+                 <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
+               pure (avails, concat fldss)
     new_assoc _ (L _ (ClsInstD _ (XClsInstDecl _))) = panic "new_assoc"
     new_assoc _ (L _ (XInstDecl _))                 = panic "new_assoc"
 
diff --git a/testsuite/tests/rename/should_fail/T16385.hs b/testsuite/tests/rename/should_fail/T16385.hs
new file mode 100644
index 0000000..174d406
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T16385.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module T16385 where
+
+instance c
+instance forall c. c
diff --git a/testsuite/tests/rename/should_fail/T16385.stderr b/testsuite/tests/rename/should_fail/T16385.stderr
new file mode 100644
index 0000000..b802756
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T16385.stderr
@@ -0,0 +1,8 @@
+
+T16385.hs:4:10: error:
+    • Instance head is not headed by a class: c
+    • In the instance declaration for ‘c’
+
+T16385.hs:5:10: error:
+    • Instance head is not headed by a class: c
+    • In the instance declaration for ‘c’
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index af382b1..4f1b1fa 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -146,3 +146,4 @@ test('T16114', normal, compile_fail, [''])
 test('T16116b', normal, compile_fail, [''])
 test('ExplicitForAllRules2', normal, compile_fail, [''])
 test('T15957_Fail', normal, compile_fail, ['-Werror -Wall -Wno-missing-signatures'])
+test('T16385', normal, compile_fail, [''])