GitLab

Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC

Commits:

f05d68b2
by Sjoerd Visscher at 2025-06-27T21:00:38+02:00
```
Fix field type mismatch error handling
```

4 changed files:

compiler/GHC/Tc/TyCl.hs
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
testsuite/tests/typecheck/should_fail/T12083a.stderr
testsuite/tests/typecheck/should_fail/T9739.stderr

Changes:

@@ -4787,6 +4787,7 @@ checkValidTyCl tc
    = setSrcSpan (getSrcSpan tc) $
      addTyConCtxt tc            $
      recoverM recovery_code     $
 +    checkNoErrs                $
      do { traceTc "Starting validity for tycon" (ppr tc)
         ; checkValidTyCon tc
         ; checkTyConConsistentWithBoot tc -- See Note [TyCon boot consistency checking]
@@ -4991,7 +4992,7 @@ checkValidTyCon tc
      check_fields ((label, con1) :| other_fields)
          -- These fields all have the same name, but are from
          -- different constructors in the data type
 -        = recoverM (return ()) $ mapM_ checkOne other_fields
 +        = mapM_ checkOne other_fields
                  -- Check that all the fields in the group have the same type
                  -- NB: this check assumes that all the constructors of a given
                  -- data type use the same type variables
@@ -5001,8 +5002,10 @@ checkValidTyCon tc
          lbl = flLabel label
          checkOne (_, con2)    -- Do it both ways to ensure they are structurally identical
 -            = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
 -                 ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
 +            = do { ((), no_errs) <- askNoErrs $
 +                    checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
 +                 ; when no_errs $
 +                    checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
              where
                  res2 = dataConOrigResTy con2
                  fty2 = dataConFieldType con2 lbl
@@ -5029,8 +5032,10 @@ checkPartialRecordField all_cons fld
  checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
                   -> Type -> Type -> Type -> Type -> TcM ()
  checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
 -  = do  { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld)
 -        ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) }
 +  = if isNothing mb_subst1
 +      then addErrTc $ TcRnCommonFieldResultTypeMismatch con1 con2 fld
 +      else when (isNothing mb_subst2) $
 +        addErrTc $ TcRnCommonFieldTypeMismatch con1 con2 fld
    where
      mb_subst1 = tcMatchTy res1 res2
      mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2

testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr

@@ -2,10 +2,3 @@ CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
      • Constructors A1 and A2 give different types for field ‘fld’
      • In the data type declaration for ‘A’
 -CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
 -    • Couldn't match type ‘[Char]’ with ‘Int’
 -      Expected: Int
 -        Actual: String
 -    • In the expression: fld
 -      In an equation for ‘fld’: fld A2 {fld = fld} = fld
+-

testsuite/tests/typecheck/should_fail/T12083a.stderr

+-
  T12083a.hs:6:1: error: [GHC-91510]
      • Illegal qualified type: Num a => a
      • In the type synonym declaration for ‘Constrd’
@@ -12,3 +11,20 @@ T12083a.hs:10:26: error: [GHC-25709]
        In the data type declaration for ‘ExistentiallyLost’
      Suggested fix:
        Enable any of the following extensions: ‘ExistentialQuantification’ or ‘GADTs’
++
 +T12083a.hs:15:5: error: [GHC-27958]
 +    • Could not deduce ‘ATF1 (p0, p1) ~ p0’
 +        arising from a superclass required to satisfy ‘TC (p0, p1)’,
 +        arising from a type ambiguity check for
 +        the type signature for ‘uie_handlers’
 +      from the context: TC u
 +        bound by the type signature for:
 +                   uie_handlers :: forall u. TC u => ADT Int
 +        at T12083a.hs:15:5-28
 +      The type variables ‘p0’, ‘p1’ are ambiguous
 +    • In the ambiguity check for ‘uie_handlers’
 +      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
 +      When checking the class method:
 +        uie_handlers :: forall u. TC u => ADT Int
 +      In the class declaration for ‘TC’
++

testsuite/tests/typecheck/should_fail/T9739.stderr

+-
  T9739.hs:4:1: error: [GHC-29210]
      • Superclass cycle for ‘Class1’
          one of whose superclasses is ‘Class3’
@@ -7,6 +6,22 @@ T9739.hs:4:1: error: [GHC-29210]
      Suggested fix:
        Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
 +T9739.hs:7:3: error: [GHC-39999]
 +    • Could not deduce ‘Class1 t0’
 +        arising from a superclass required to satisfy ‘Class3 t0’,
 +        arising from a type ambiguity check for
 +        the type signature for ‘class2’
 +      from the context: (Class2 t a, Class3 t)
 +        bound by the type signature for:
 +                   class2 :: forall t a m. (Class2 t a, Class3 t) => a -> m
 +        at T9739.hs:7:3-32
 +      The type variable ‘t0’ is ambiguous
 +    • In the ambiguity check for ‘class2’
 +      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
 +      When checking the class method:
 +        class2 :: forall t a m. (Class2 t a, Class3 t) => a -> m
 +      In the class declaration for ‘Class2’
++
  T9739.hs:9:1: error: [GHC-29210]
      • Superclass cycle for ‘Class3’
          one of whose superclasses is ‘Class1’
@@ -14,3 +29,4 @@ T9739.hs:9:1: error: [GHC-29210]
      • In the class declaration for ‘Class3’
      Suggested fix:
        Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
++