re PR fortran/65548 (gfc_conv_procedure_call)

gcc/fortran/ChangeLog:

2015-05-19  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/65548
	* trans-stmt.c (gfc_trans_allocate): Always retrieve the
	descriptor or a reference to a source= expression for
	arrays and non-arrays, respectively.  Use a temporary
	symbol and gfc_trans_assignment for all source=
	assignments to allocated objects besides for class and
	derived types.

gcc/testsuite/ChangeLog:

2015-05-19  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/65548
	* gfortran.dg/allocate_with_source_5.f90: Extend test.

From-SVN: r223445

gcc/fortran/ChangeLog

+2015-05-20  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/65548
+	* trans-stmt.c (gfc_trans_allocate): Always retrieve the
+	descriptor or a reference to a source= expression for
+	arrays and non-arrays, respectively.  Use a temporary
+	symbol and gfc_trans_assignment for all source=
+	assignments to allocated objects besides for class and
+	derived types.
+
 2015-05-19  Jakub Jelinek  <jakub@redhat.com>
 
 	PR middle-end/66199

gcc/testsuite/ChangeLog

+2015-05-20  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/65548
+	* gfortran.dg/allocate_with_source_5.f90: Extend test.
+
 2015-05-20  Bin Cheng  <bin.cheng@arm.com>
 
 	PR tree-optimization/65447

gcc/testsuite/gfortran.dg/allocate_with_source_5.f90

 ! { dg-do run }
 !
+! Contributed by Juergen Reuter
 ! Check that pr65548 is fixed.
-! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
-
-module allocate_with_source_5_module
+!
 
+module selectors
   type :: selector_t
-    integer, dimension(:), allocatable :: map
-    real, dimension(:), allocatable :: weight
-  contains
-    procedure :: init => selector_init
-  end type selector_t
+     integer, dimension(:), allocatable :: map
+     real, dimension(:), allocatable :: weight
+   contains
+     procedure :: init => selector_init
+   end type selector_t
 
 contains
 
@@ -34,19 +34,126 @@ contains
     end if
   end subroutine selector_init
 
-end module allocate_with_source_5_module
+end module selectors
+
+module phs_base
+  type :: flavor_t
+  contains
+     procedure :: get_mass => flavor_get_mass
+  end type flavor_t
+
+  type :: phs_config_t
+     integer :: n_in = 0
+     type(flavor_t), dimension(:,:), allocatable :: flv
+  end type phs_config_t
+
+  type :: phs_t
+     class(phs_config_t), pointer :: config => null ()
+     real, dimension(:), allocatable :: m_in
+  end type phs_t
+
+contains
+
+  elemental function flavor_get_mass (flv) result (mass)
+    real :: mass
+    class(flavor_t), intent(in) :: flv
+    mass = 42.0
+  end function flavor_get_mass
+
+  subroutine phs_base_init (phs, phs_config)
+    class(phs_t), intent(out) :: phs
+    class(phs_config_t), intent(in), target :: phs_config
+    phs%config => phs_config
+    allocate (phs%m_in  (phs%config%n_in), &
+         source = phs_config%flv(:phs_config%n_in, 1)%get_mass ())
+  end subroutine phs_base_init
+
+end module phs_base
+
+module foo
+  type :: t
+     integer :: n
+     real, dimension(:,:), allocatable :: val
+   contains
+     procedure :: make => t_make
+     generic :: get_int => get_int_array, get_int_element
+     procedure :: get_int_array => t_get_int_array
+     procedure :: get_int_element => t_get_int_element
+  end type t
+
+contains
+
+  subroutine t_make (this)
+    class(t), intent(inout) :: this
+    real, dimension(:), allocatable :: int
+    allocate (int (0:this%n-1), source=this%get_int())
+  end subroutine t_make
+
+  pure function t_get_int_array (this) result (array)
+    class(t), intent(in) :: this
+    real, dimension(this%n) :: array
+    array = this%val (0:this%n-1, 4)
+  end function t_get_int_array
+
+  pure function t_get_int_element (this, set) result (element)
+    class(t), intent(in) :: this
+    integer, intent(in) :: set
+    real :: element
+    element = this%val (set, 4)
+  end function t_get_int_element
+end module foo
+module foo2
+  type :: t2
+     integer :: n
+     character(32), dimension(:), allocatable :: md5
+   contains
+     procedure :: init => t2_init
+  end type t2
+
+contains
+
+  subroutine t2_init (this)
+    class(t2), intent(inout) :: this
+    character(32), dimension(:), allocatable :: md5
+    allocate (md5 (this%n), source=this%md5)
+    if (md5(1) /= "tst                             ") call abort()
+    if (md5(2) /= "                                ") call abort()
+    if (md5(3) /= "fooblabar                       ") call abort()
+  end subroutine t2_init
+end module foo2
+
+program test
+  use selectors
+  use phs_base
+  use foo
+  use foo2
+
+  type(selector_t) :: sel
+  type(phs_t) :: phs
+  type(phs_config_t) :: phs_config
+  type(t) :: o
+  type(t2) :: o2
+
+  call sel%init([2., 0., 3., 0., 4.])
+
+  if (any(sel%map /= [1, 3, 5])) call abort()
+  if (any(abs(sel%weight - [2., 3., 4.] / 9.) > 1E-6)) call abort()
 
-program allocate_with_source_5
-  use allocate_with_source_5_module
+  phs_config%n_in = 2
+  allocate (phs_config%flv (phs_config%n_in, 1))
+  call phs_base_init (phs, phs_config)
 
-  class(selector_t), allocatable :: sel;
-  real, dimension(5) :: w = [ 1, 0, 2, 0, 3];
+  if (any(abs(phs%m_in - [42.0, 42.0]) > 1E-6)) call abort()
 
-  allocate (sel)
-  call sel%init(w)
+  o%n = 2
+  allocate (o%val(2,4))
+  call o%make()
 
-  if (any(sel%map /= [ 1, 3, 5])) call abort()
-  if (any(abs(sel%weight - [1, 2, 3] / 6) < 1E-6)) call abort()
-end program allocate_with_source_5
-! { dg-final { cleanup-modules "allocate_with_source_5_module" } }
+  o2%n = 3
+  allocate(o2%md5(o2%n))
+  o2%md5(1) = "tst"
+  o2%md5(2) = ""
+  o2%md5(3) = "fooblabar"
+  call o2%init()
+end program test