Fortran: Fix double function call with -fcheck=pointer [PR]
gcc/fortran/ChangeLog: PR fortran/82376 * trans-expr.c (gfc_conv_procedure_call): Evaluate function result and then pass a pointer. gcc/testsuite/ChangeLog: PR fortran/82376 * gfortran.dg/PR82376.f90: New test.
This commit is contained in:
parent
ea3d2e3c16
commit
b020cee5af
2 changed files with 61 additions and 5 deletions
|
@ -6014,11 +6014,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
|| (!e->value.function.esym
|
||||
&& e->symtree->n.sym->attr.pointer))
|
||||
&& fsym && fsym->attr.target)
|
||||
{
|
||||
gfc_conv_expr (&parmse, e);
|
||||
parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
|
||||
}
|
||||
|
||||
/* Make sure the function only gets called once. */
|
||||
gfc_conv_expr_reference (&parmse, e, false);
|
||||
else if (e->expr_type == EXPR_FUNCTION
|
||||
&& e->symtree->n.sym->result
|
||||
&& e->symtree->n.sym->result != e->symtree->n.sym
|
||||
|
|
59
gcc/testsuite/gfortran.dg/PR82376.f90
Normal file
59
gcc/testsuite/gfortran.dg/PR82376.f90
Normal file
|
@ -0,0 +1,59 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-fdump-tree-original -fcheck=pointer" }
|
||||
!
|
||||
! Test the fix for PR82376. The pointer check was doubling up the call
|
||||
! to new. The fix reduces the count of 'new' from 5 to 4.
|
||||
!
|
||||
! Contributed by José Rui Faustino de Sousa <jrfsousa@gmail.com>
|
||||
!
|
||||
program main_p
|
||||
|
||||
integer, parameter :: n = 10
|
||||
|
||||
type :: foo_t
|
||||
integer, pointer :: v =>null()
|
||||
end type foo_t
|
||||
|
||||
integer, save :: pcnt = 0
|
||||
|
||||
type(foo_t) :: int
|
||||
integer :: i
|
||||
|
||||
do i = 1, n
|
||||
call init(int, i)
|
||||
if(.not.associated(int%v)) stop 1
|
||||
if(int%v/=i) stop 2
|
||||
if(pcnt/=i) stop 3
|
||||
end do
|
||||
|
||||
contains
|
||||
|
||||
function new(data) result(this)
|
||||
integer, target, intent(in) :: data
|
||||
|
||||
integer, pointer :: this
|
||||
|
||||
nullify(this)
|
||||
this => data
|
||||
pcnt = pcnt + 1
|
||||
return
|
||||
end function new
|
||||
|
||||
subroutine init(this, data)
|
||||
type(foo_t), intent(out) :: this
|
||||
integer, intent(in) :: data
|
||||
|
||||
call set(this, new(data))
|
||||
return
|
||||
end subroutine init
|
||||
|
||||
subroutine set(this, that)
|
||||
type(foo_t), intent(inout) :: this
|
||||
integer, target, intent(in) :: that
|
||||
|
||||
this%v => that
|
||||
return
|
||||
end subroutine set
|
||||
|
||||
end program main_p
|
||||
! { dg-final { scan-tree-dump-times "new" 4 "original" } }
|
Loading…
Add table
Reference in a new issue