Dear all,
the attached patch fixes a regression introduced by my patches for the
F2008-style allocate(). In this case a function returning an array of BT_CLASS
objects can not be conv'ed using conv_expr_descriptor, but needs to be
conv_expr_reference()'ed, because the _data component has the descriptor already
and just needs to be addressed correctly.
Bootstraps and regtests ok on x86_64-linux-gnu/f21.
Ok for trunk?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
gcc/fortran/ChangeLog:
2015-08-06 Andre Vehreschild <[email protected]>
* trans-stmt.c (gfc_trans_allocate): Do not conv_expr_descriptor
for functions returning a class object. Get the reference
instead.
gcc/testsuite/ChangeLog:
2015-08-06 Andre Vehreschild <[email protected]>
* gfortran.dg/allocate_with_source_10.f08: New test.
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6409f7f..3f90b76 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5187,9 +5187,14 @@ gfc_trans_allocate (gfc_code * code)
/* In all other cases evaluate the expr3. */
symbol_attribute attr;
/* Get the descriptor for all arrays, that are not allocatable or
- pointer, because the latter are descriptors already. */
+ pointer, because the latter are descriptors already.
+ The exception are function calls returning a class object:
+ For those conv_expr_descriptor does not work. */
attr = gfc_expr_attr (code->expr3);
- if (code->expr3->rank != 0 && !attr.allocatable && !attr.pointer)
+ if (code->expr3->rank != 0
+ && ((!attr.allocatable && !attr.pointer)
+ || (code->expr3->expr_type == EXPR_FUNCTION
+ && code->expr3->ts.type != BT_CLASS)))
gfc_conv_expr_descriptor (&se, code->expr3);
else
gfc_conv_expr_reference (&se, code->expr3);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08 b/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08
new file mode 100644
index 0000000..88962c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_10.f08
@@ -0,0 +1,52 @@
+!{ dg-do run }
+!
+! Testcase for pr66927
+! Contributed by Juergen Reuter <[email protected]>
+
+module processes
+ implicit none
+ private
+
+ type :: t1_t
+ real :: p = 0.0
+ end type t1_t
+
+ type :: t2_t
+ private
+ type(t1_t), dimension(:), allocatable :: p
+ contains
+ procedure :: func => t2_func
+ end type t2_t
+
+ type, public :: t3_t
+ type(t2_t), public :: int_born
+ end type t3_t
+
+ public :: evaluate
+
+contains
+
+ function t2_func (int) result (p)
+ class(t2_t), intent(in) :: int
+ type(t1_t), dimension(:), allocatable :: p
+ allocate(p(5))
+ end function t2_func
+
+ subroutine evaluate (t3)
+ class(t3_t), intent(inout) :: t3
+ type(t1_t), dimension(:), allocatable :: p_born
+ allocate (p_born(1:size(t3%int_born%func ())), &
+ source = t3%int_born%func ())
+ if (.not. allocated(p_born)) call abort()
+ if (size(p_born) /= 5) call abort()
+ end subroutine evaluate
+
+end module processes
+
+program pr66927
+use processes
+type(t3_t) :: o
+call evaluate(o)
+end
+
+
