From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/class_37.f03 | 263 +++++++++++++++++++++++++++++++++ 1 file changed, 263 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/class_37.f03 (limited to 'gcc/testsuite/gfortran.dg/class_37.f03') diff --git a/gcc/testsuite/gfortran.dg/class_37.f03 b/gcc/testsuite/gfortran.dg/class_37.f03 new file mode 100644 index 000000000..f951ea1f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_37.f03 @@ -0,0 +1,263 @@ +! { dg-do compile } +! Test fix for PR47082, in which an ICE in the ALLOCATE at line 248. +! +! Contributed by Salvatore Filippone +! +module psb_penv_mod + + interface psb_init + module procedure psb_init + end interface + + interface psb_exit + module procedure psb_exit + end interface + + interface psb_info + module procedure psb_info + end interface + + integer, private, save :: nctxt=0 + + + +contains + + + subroutine psb_init(ictxt,np,basectxt,ids) + implicit none + integer, intent(out) :: ictxt + integer, intent(in), optional :: np, basectxt, ids(:) + + + ictxt = nctxt + nctxt = nctxt + 1 + + end subroutine psb_init + + subroutine psb_exit(ictxt,close) + implicit none + integer, intent(inout) :: ictxt + logical, intent(in), optional :: close + + nctxt = max(0, nctxt - 1) + + end subroutine psb_exit + + + subroutine psb_info(ictxt,iam,np) + + implicit none + + integer, intent(in) :: ictxt + integer, intent(out) :: iam, np + + iam = 0 + np = 1 + + end subroutine psb_info + + +end module psb_penv_mod + + +module psb_indx_map_mod + + type :: psb_indx_map + + integer :: state = -1 + integer :: ictxt = -1 + integer :: mpic = -1 + integer :: global_rows = -1 + integer :: global_cols = -1 + integer :: local_rows = -1 + integer :: local_cols = -1 + + + end type psb_indx_map + +end module psb_indx_map_mod + + + +module psb_gen_block_map_mod + use psb_indx_map_mod + + type, extends(psb_indx_map) :: psb_gen_block_map + integer :: min_glob_row = -1 + integer :: max_glob_row = -1 + integer, allocatable :: loc_to_glob(:), srt_l2g(:,:), vnl(:) + contains + + procedure, pass(idxmap) :: gen_block_map_init => block_init + + end type psb_gen_block_map + + private :: block_init + +contains + + subroutine block_init(idxmap,ictxt,nl,info) + use psb_penv_mod + implicit none + class(psb_gen_block_map), intent(inout) :: idxmap + integer, intent(in) :: ictxt, nl + integer, intent(out) :: info + ! To be implemented + integer :: iam, np, i, j, ntot + integer, allocatable :: vnl(:) + + info = 0 + call psb_info(ictxt,iam,np) + if (np < 0) then + info = -1 + return + end if + + allocate(vnl(0:np),stat=info) + if (info /= 0) then + info = -2 + return + end if + + vnl(:) = 0 + vnl(iam) = nl + ntot = sum(vnl) + vnl(1:np) = vnl(0:np-1) + vnl(0) = 0 + do i=1,np + vnl(i) = vnl(i) + vnl(i-1) + end do + if (ntot /= vnl(np)) then +! !$ write(0,*) ' Mismatch in block_init ',ntot,vnl(np) + end if + + idxmap%global_rows = ntot + idxmap%global_cols = ntot + idxmap%local_rows = nl + idxmap%local_cols = nl + idxmap%ictxt = ictxt + idxmap%state = 1 + + idxmap%min_glob_row = vnl(iam)+1 + idxmap%max_glob_row = vnl(iam+1) + call move_alloc(vnl,idxmap%vnl) + allocate(idxmap%loc_to_glob(nl),stat=info) + if (info /= 0) then + info = -2 + return + end if + + end subroutine block_init + +end module psb_gen_block_map_mod + + +module psb_descriptor_type + use psb_indx_map_mod + + implicit none + + + type psb_desc_type + integer, allocatable :: matrix_data(:) + integer, allocatable :: halo_index(:) + integer, allocatable :: ext_index(:) + integer, allocatable :: ovrlap_index(:) + integer, allocatable :: ovrlap_elem(:,:) + integer, allocatable :: ovr_mst_idx(:) + integer, allocatable :: bnd_elem(:) + class(psb_indx_map), allocatable :: indxmap + integer, allocatable :: lprm(:) + type(psb_desc_type), pointer :: base_desc => null() + integer, allocatable :: idx_space(:) + end type psb_desc_type + + +end module psb_descriptor_type + +module psb_cd_if_tools_mod + + use psb_descriptor_type + use psb_gen_block_map_mod + + interface psb_cdcpy + subroutine psb_cdcpy(desc_in, desc_out, info) + use psb_descriptor_type + + implicit none + !....parameters... + + type(psb_desc_type), intent(in) :: desc_in + type(psb_desc_type), intent(out) :: desc_out + integer, intent(out) :: info + end subroutine psb_cdcpy + end interface + + +end module psb_cd_if_tools_mod + +module psb_cd_tools_mod + + use psb_cd_if_tools_mod + + interface psb_cdall + + subroutine psb_cdall(ictxt, desc, info,mg,ng,vg,vl,flag,nl,repl, globalcheck) + use psb_descriptor_type + implicit None + Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl + integer, intent(in) :: flag + logical, intent(in) :: repl, globalcheck + integer, intent(out) :: info + type(psb_desc_type), intent(out) :: desc + + optional :: mg,ng,vg,vl,flag,nl,repl, globalcheck + end subroutine psb_cdall + + end interface + +end module psb_cd_tools_mod +module psb_base_tools_mod + use psb_cd_tools_mod +end module psb_base_tools_mod + +subroutine psb_cdall(ictxt, desc, info,mg,ng,vg,vl,flag,nl,repl, globalcheck) + use psb_descriptor_type + use psb_gen_block_map_mod + use psb_base_tools_mod, psb_protect_name => psb_cdall + implicit None + Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl + integer, intent(in) :: flag + logical, intent(in) :: repl, globalcheck + integer, intent(out) :: info + type(psb_desc_type), intent(out) :: desc + + optional :: mg,ng,vg,vl,flag,nl,repl, globalcheck + integer :: err_act, n_, flag_, i, me, np, nlp, nnv, lr + integer, allocatable :: itmpsz(:) + + + + info = 0 + desc%base_desc => null() + if (allocated(desc%indxmap)) then + write(0,*) 'Allocated on an intent(OUT) var?' + end if + + allocate(psb_gen_block_map :: desc%indxmap, stat=info) + if (info == 0) then + select type(aa => desc%indxmap) + type is (psb_gen_block_map) + call aa%gen_block_map_init(ictxt,nl,info) + class default + ! This cannot happen + info = -1 + end select + end if + + return + +end subroutine psb_cdall + + -- cgit v1.2.3