flang/test/Semantics/selecttype04.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Check F'2023 C1167
   3 module m
   4   type :: base(kindparam, lenparam)
   5     integer, kind :: kindparam
   6     integer, len :: lenparam
   7   end type
   8   type, extends(base) :: ext1
   9    contains
  10     procedure :: tbp
  11   end type
  12   type, extends(ext1) :: ext2
  13   end type
  14  contains
  15   function tbp(x)
  16     class(ext1(123,*)), target :: x
  17     class(ext1(123,:)), pointer :: tbp
  18     tbp => x
  19   end
  20   subroutine test
  21     type(ext1(123,456)), target :: var
  22     select type (sel => var%tbp())
  23     type is (ext1(123,*)) ! ok
  24     type is (ext2(123,*)) ! ok
  25     !ERROR: Type specification 'ext1(kindparam=234_4,lenparam=*)' must be an extension of TYPE 'ext1(kindparam=123_4,lenparam=:)'
  26     type is (ext1(234,*))
  27     !ERROR: Type specification 'ext2(kindparam=234_4,lenparam=*)' must be an extension of TYPE 'ext1(kindparam=123_4,lenparam=:)'
  28     type is (ext2(234,*))
  29     end select
  30   end
  31 end