gcc/testsuite/gfortran.dg/array_constructor_37.f90

   1 ! { dg-do compile }
   2 ! Check the fix for PR47850, in which the argument of ANY, below, was not
   3 ! simplified, thereby causing an ICE.
   4 !
   5 ! Contributed by Tobias Burnus  <burnus@gcc.gnu.org> but based on James van Buskirk's program in
   6 ! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/625faf82578e9af8
   7 !
   8 !
   9 program Cindex
  10    implicit none
  11    integer,parameter :: SENSOR_CHANNEL(8) = &
  12       [10,12,17,20,22,30,33,34]
  13    integer,parameter :: NLTE_CHANNEL(3) = [20,22,34]
  14    integer,parameter :: N_NLTE_CHANNELS = size(NLTE_CHANNEL)
  15    integer,parameter :: N_CHANNELS = size(SENSOR_CHANNEL)
  16    integer i
  17    integer,parameter :: C_INDEX(8) = unpack( &
  18       vector = [(i,i=1,size(SENSOR_CHANNEL))], &
  19       mask = [(any(SENSOR_CHANNEL(i) == NLTE_CHANNEL), &
  20          i=lbound(SENSOR_CHANNEL,1),ubound(SENSOR_CHANNEL,1))], &
  21       field = 0)
  22    character(20) fmt
  23
  24    write(fmt,'(a,i0,a)') '(a,t19,',size(SENSOR_CHANNEL),'(i3:","))'
  25    write(*,fmt) 'SENSOR_CHANNEL = ',SENSOR_CHANNEL
  26    write(fmt,'(a,i0,a)') '(a,t19,',size(NLTE_CHANNEL),'(i3:","))'
  27    write(*,fmt) 'NLTE_CHANNEL = ',NLTE_CHANNEL
  28    write(*,'(a,t19,i3)') 'N_NLTE_CHANNELS = ',N_NLTE_CHANNELS
  29    write(*,'(a,t19,i3)') 'N_CHANNELS = ',N_CHANNELS
  30    write(fmt,'(a,i0,a)') '(a,t19,',size(C_INDEX),'(i3:","))'
  31    write(*,fmt) 'C_INDEX = ',C_INDEX
  32 end program Cindex