2011-02-19 Tobias Burnus
PR fortran/47775 * trans-expr.c (arrayfunc_assign_needs_temporary): Use esym to check whether the specific procedure returns an allocatable or pointer. 2011-02-19 Tobias Burnus PR fortran/47775 * gfortran.dg/func_result_6.f90: New. From-SVN: r170312
This commit is contained in:
parent
4f2f35f267
commit
2fa85cc4fe
|
@ -1,3 +1,10 @@
|
|||
2011-02-19 Tobias Burnus
|
||||
|
||||
PR fortran/47775
|
||||
* trans-expr.c (arrayfunc_assign_needs_temporary): Use
|
||||
esym to check whether the specific procedure returns an
|
||||
allocatable or pointer.
|
||||
|
||||
2011-02-14 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/47569
|
||||
|
|
|
@ -4405,9 +4405,13 @@ arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2)
|
|||
if (gfc_ref_needs_temporary_p (expr1->ref))
|
||||
return true;
|
||||
|
||||
/* Functions returning pointers need temporaries. */
|
||||
if (expr2->symtree->n.sym->attr.pointer
|
||||
|| expr2->symtree->n.sym->attr.allocatable)
|
||||
/* Functions returning pointers or allocatables need temporaries. */
|
||||
c = expr2->value.function.esym
|
||||
? (expr2->value.function.esym->attr.pointer
|
||||
|| expr2->value.function.esym->attr.allocatable)
|
||||
: (expr2->symtree->n.sym->attr.pointer
|
||||
|| expr2->symtree->n.sym->attr.allocatable);
|
||||
if (c)
|
||||
return true;
|
||||
|
||||
/* Character array functions need temporaries unless the
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2011-02-19 Tobias Burnus
|
||||
|
||||
PR fortran/47775
|
||||
* gfortran.dg/func_result_6.f90: New.
|
||||
|
||||
2011-02-17 Uros Bizjak <ubizjak@gmail.com>
|
||||
|
||||
PR target/43653
|
||||
|
|
|
@ -0,0 +1,73 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/47775
|
||||
!
|
||||
! Contributed by Fran Martinez Fadrique
|
||||
!
|
||||
! Before, a temporary was missing for generic procedured (cf. test())
|
||||
! as the allocatable attribute was ignored for the check whether a
|
||||
! temporary is required
|
||||
!
|
||||
module m
|
||||
type t
|
||||
contains
|
||||
procedure, NOPASS :: foo => foo
|
||||
generic :: gen => foo
|
||||
end type t
|
||||
contains
|
||||
function foo(i)
|
||||
integer, allocatable :: foo(:)
|
||||
integer :: i
|
||||
allocate(foo(2))
|
||||
foo(1) = i
|
||||
foo(2) = i + 10
|
||||
end function foo
|
||||
end module m
|
||||
|
||||
use m
|
||||
type(t) :: x
|
||||
integer, pointer :: ptr1, ptr2
|
||||
integer, target :: bar1(2)
|
||||
integer, target, allocatable :: bar2(:)
|
||||
|
||||
allocate(bar2(2))
|
||||
ptr1 => bar1(2)
|
||||
ptr2 => bar2(2)
|
||||
|
||||
bar1 = x%gen(1)
|
||||
if (ptr1 /= 11) call abort()
|
||||
bar1 = x%foo(2)
|
||||
if (ptr1 /= 12) call abort()
|
||||
bar2 = x%gen(3)
|
||||
if (ptr2 /= 13) call abort()
|
||||
bar2 = x%foo(4)
|
||||
if (ptr2 /= 14) call abort()
|
||||
bar2(:) = x%gen(5)
|
||||
if (ptr2 /= 15) call abort()
|
||||
bar2(:) = x%foo(6)
|
||||
if (ptr2 /= 16) call abort()
|
||||
|
||||
call test()
|
||||
end
|
||||
|
||||
subroutine test
|
||||
interface gen
|
||||
procedure foo
|
||||
end interface gen
|
||||
|
||||
integer, target :: bar(2)
|
||||
integer, pointer :: ptr
|
||||
bar = [1,2]
|
||||
ptr => bar(2)
|
||||
if (ptr /= 2) call abort()
|
||||
bar = gen()
|
||||
if (ptr /= 77) call abort()
|
||||
contains
|
||||
function foo()
|
||||
integer, allocatable :: foo(:)
|
||||
allocate(foo(2))
|
||||
foo = [33, 77]
|
||||
end function foo
|
||||
end subroutine test
|
||||
|
||||
! { dg-final { cleanup-modules "m" } }
|
Loading…
Reference in New Issue