1! { dg-do run }
2! Tests the fix for PR27411, in which the array reference on line
3! 18 caused an ICE because the derived type, rather than its integer
4! component, was appearing in the index expression.
5!
6! Contributed by Richard Maine  <1fhcwee02@sneakemail.com>
7!
8module gd_calc
9  type calc_signal_type
10    integer :: dummy
11    logical :: used
12    integer :: signal_number
13  end type
14contains
15  subroutine activate_gd_calcs (used, outputs)
16    logical, intent(inout) :: used(:)
17    type(calc_signal_type), pointer :: outputs(:)
18      outputs%used = used(outputs%signal_number)
19    return
20  end subroutine activate_gd_calcs
21end module gd_calc
22
23  use gd_calc
24  integer, parameter :: ndim = 4
25  integer :: i
26  logical :: used_(ndim)
27  type(calc_signal_type), pointer :: outputs_(:)
28  allocate (outputs_(ndim))
29  forall (i = 1:ndim) outputs_(i)%signal_number = ndim + 1 - i
30  used_ = (/.true., .false., .true., .true./)
31  call activate_gd_calcs (used_, outputs_)
32  if (any (outputs_(ndim:1:-1)%used .neqv. used_)) call abort ()
33end
34