xref: /llvm-project/flang/test/Semantics/selecttype04.f90 (revision 069aee0793064b800f130e740e37dd7d264b7802)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Check F'2023 C1167
3module 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
31end
32