Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 261 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/class_37.f03 b/gcc-4.9/gcc/testsuite/gfortran.dg/class_37.f03
new file mode 100644
index 000000000..1d7599962
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/class_37.f03
@@ -0,0 +1,261 @@
+! { dg-do compile }
+! Test fix for PR47082, in which an ICE in the ALLOCATE at line 248.
+!
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+!
+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