flang/test/Semantics/resolve87.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! C737 If EXTENDS appears and the type being defined has a potential
   3 ! subobject component of type EVENT_TYPE or LOCK_TYPE from the intrinsic
   4 ! module ISO_FORTRAN_ENV, its parent type shall be EVENT_TYPE or LOCK_TYPE
   5 ! or have a potential subobject component of type EVENT_TYPE or LOCK_TYPE.
   6 module not_iso_fortran_env
   7   type event_type
   8   end type
   9
  10   type lock_type
  11   end type
  12 end module
  13
  14 subroutine C737_a()
  15   use iso_fortran_env
  16
  17   type lockGrandParentType
  18     type(lock_type) :: grandParentField
  19   end type lockGrandParentType
  20
  21   type, extends(lockGrandParentType) :: lockParentType
  22     real :: parentField
  23   end type lockParentType
  24
  25   type eventParentType
  26     type(event_type) :: parentField
  27   end type eventParentType
  28
  29   type noLockParentType
  30   end type noLockParentType
  31
  32   type, extends(lockParentType) :: goodChildType1
  33     type(lock_type) :: childField
  34   end type goodChildType1
  35
  36   type, extends(lockParentType) :: goodChildType2
  37     type(event_type) :: childField
  38   end type goodChildType2
  39
  40   type, extends(lock_type) :: goodChildType3
  41     type(event_type) :: childField
  42   end type goodChildType3
  43
  44   type, extends(event_type) :: goodChildType4
  45     type(lock_type) :: childField
  46   end type goodChildType4
  47
  48   !ERROR: Type 'badchildtype1' has an EVENT_TYPE or LOCK_TYPE component, so the type at the base of its type extension chain ('nolockparenttype') must either have an EVENT_TYPE or LOCK_TYPE component, or be EVENT_TYPE or LOCK_TYPE
  49   type, extends(noLockParentType) :: badChildType1
  50     type(lock_type) :: childField
  51   end type badChildType1
  52
  53   !ERROR: Type 'badchildtype2' has an EVENT_TYPE or LOCK_TYPE component, so the type at the base of its type extension chain ('nolockparenttype') must either have an EVENT_TYPE or LOCK_TYPE component, or be EVENT_TYPE or LOCK_TYPE
  54   type, extends(noLockParentType) :: badChildType2
  55     type(event_type) :: childField
  56   end type badChildType2
  57
  58   !ERROR: Type 'badchildtype3' has an EVENT_TYPE or LOCK_TYPE component, so the type at the base of its type extension chain ('nolockparenttype') must either have an EVENT_TYPE or LOCK_TYPE component, or be EVENT_TYPE or LOCK_TYPE
  59   type, extends(noLockParentType) :: badChildType3
  60     type(lockParentType) :: childField
  61   end type badChildType3
  62
  63   !ERROR: Type 'badchildtype4' has an EVENT_TYPE or LOCK_TYPE component, so the type at the base of its type extension chain ('nolockparenttype') must either have an EVENT_TYPE or LOCK_TYPE component, or be EVENT_TYPE or LOCK_TYPE
  64   type, extends(noLockParentType) :: badChildType4
  65     type(eventParentType) :: childField
  66   end type badChildType4
  67
  68 end subroutine C737_a
  69
  70 subroutine C737_b()
  71   use not_iso_fortran_env
  72
  73   type lockParentType
  74     type(lock_type) :: parentField
  75   end type lockParentType
  76
  77   type noLockParentType
  78   end type noLockParentType
  79
  80   ! actually OK since this is not the predefined lock_type
  81   type, extends(noLockParentType) :: notBadChildType1
  82     type(lock_type) :: childField
  83   end type notBadChildType1
  84
  85   ! actually OK since this is not the predefined event_type
  86   type, extends(noLockParentType) :: notBadChildType2
  87     type(event_type) :: childField
  88   end type notBadChildType2
  89
  90 end subroutine C737_b