flang/test/Semantics/resolve87.f90

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