gcc/testsuite/gfortran.dg/assumed_rank_16.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests the fix for PR89363, in which the rank of unallocated or unassociated
   4 ! entities, argument associated with assumed rank dummies, was not being set.
   5 !
   6 ! Contributed by Reinhold Bader  <Bader@lrz.de>
   7 !
   8 module mod_ass_rank_02
   9   implicit none
  10 contains
  11   subroutine procr(this,flag)
  12     real, allocatable :: this(..)
  13     logical :: flag
  14     if (rank(this) /= 2 .or. allocated(this)) then
  15        write(*,*) 'FAIL procr', rank(this), allocated(this)
  16        flag = .FALSE.
  17      end if
  18   end subroutine procr
  19   subroutine procs(this,flag)
  20     real, allocatable :: this(..)
  21     logical :: flag
  22     if (rank(this) /= 2 .or. .not. allocated(this)) then
  23        write(*,*) 'FAIL procs status', rank(this), allocated(this)
  24        flag = .FALSE.
  25      end if
  26      if (size(this,1) /= 2 .and. size(this,2) /= 5) then
  27        write(*,*) 'FAIL procs shape', size(this)
  28        flag = .FALSE.
  29      end if
  30   end subroutine procs
  31 end module mod_ass_rank_02
  32 program ass_rank_02
  33   use mod_ass_rank_02
  34   implicit none
  35   real, allocatable :: x(:,:)
  36   logical :: flag
  37
  38   flag = .TRUE.
  39   call procr(x,flag)
  40   if (.not.flag) stop 1
  41   allocate(x(2,5))
  42   call procs(x,flag)
  43   if (.not.flag) stop 2
  44   deallocate(x)
  45 end program ass_rank_02