diff options
| -rw-r--r-- | compiler/rename/RnNames.hs | 32 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/T16385.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/T16385.stderr | 8 | ||||
| -rw-r--r-- | 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 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, ['']) |