Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/assumed_rank_16.f90 @ 152:2b5abeee2509
update gcc11
author | anatofuz |
---|---|
date | Mon, 25 May 2020 07:50:57 +0900 |
parents | 1830386684a0 |
children |
line wrap: on
line source
! { dg-do run } ! ! Tests the fix for PR89363, in which the rank of unallocated or unassociated ! entities, argument associated with assumed rank dummies, was not being set. ! ! Contributed by Reinhold Bader <Bader@lrz.de> ! module mod_ass_rank_02 implicit none contains subroutine procr(this,flag) real, allocatable :: this(..) logical :: flag if (rank(this) /= 2 .or. allocated(this)) then write(*,*) 'FAIL procr', rank(this), allocated(this) flag = .FALSE. end if end subroutine procr subroutine procs(this,flag) real, allocatable :: this(..) logical :: flag if (rank(this) /= 2 .or. .not. allocated(this)) then write(*,*) 'FAIL procs status', rank(this), allocated(this) flag = .FALSE. end if if (size(this,1) /= 2 .and. size(this,2) /= 5) then write(*,*) 'FAIL procs shape', size(this) flag = .FALSE. end if end subroutine procs end module mod_ass_rank_02 program ass_rank_02 use mod_ass_rank_02 implicit none real, allocatable :: x(:,:) logical :: flag flag = .TRUE. call procr(x,flag) if (.not.flag) stop 1 allocate(x(2,5)) call procs(x,flag) if (.not.flag) stop 2 deallocate(x) end program ass_rank_02