summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2019-03-04 09:52:14 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-03-06 16:05:45 -0500
commit78dd04f9126dc5df966070b8db4b39a517a9d99f (patch)
tree151aeab576581094c09d293a0f4157fcb3e8521b
parenta4944d8d98770b869f6aa5fb667877c56c3f8825 (diff)
downloadhaskell-78dd04f9126dc5df966070b8db4b39a517a9d99f.tar.gz
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.
-rw-r--r--compiler/rename/RnNames.hs32
-rw-r--r--testsuite/tests/rename/should_fail/T16385.hs5
-rw-r--r--testsuite/tests/rename/should_fail/T16385.stderr8
-rw-r--r--testsuite/tests/rename/should_fail/all.T1
4 files changed, 38 insertions, 8 deletions
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 09fa81576a..08f100750e 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 0000000000..174d406c9e
--- /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 0000000000..b80275643c
--- /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 af382b1a0c..4f1b1fa34b 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, [''])