1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3! Test the fix for PR55172.
4!
5! Contributed by Arjen Markus  <arjen.markus@deltares.nl>
6!
7module gn
8  type :: ncb
9  end type ncb
10  type, public :: tn
11     class(ncb), allocatable, dimension(:) :: cb
12  end type tn
13contains
14  integer function name(self)
15    implicit none
16    class (tn), intent(in) :: self
17    select type (component => self%cb(i)) ! { dg-error "has no IMPLICIT type" }
18    end select
19  end function name
20end module gn
21
22! Further issues, raised by Tobias Burnus in the course of fixing the PR
23
24module gn1
25  type :: ncb1
26  end type ncb1
27  type, public :: tn1
28     class(ncb1), allocatable, dimension(:) :: cb
29  end type tn1
30contains
31  integer function name(self)
32    implicit none
33    class (tn1), intent(in) :: self
34    select type (component => self%cb([4,7+1])) ! { dg-error "needs a temporary" }
35    end select
36  end function name
37end module gn1
38
39module gn2
40  type :: ncb2
41  end type ncb2
42  type, public :: tn2
43     class(ncb2), allocatable :: cb[:]
44  end type tn2
45contains
46  integer function name(self)
47    implicit none
48    class (tn2), intent(in) :: self
49    select type (component => self%cb[4]) ! { dg-error "must not be coindexed" }
50    end select
51  end function name
52end module gn2
53