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.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 213f32b..b83b021 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/PR82376.f90 b/gcc/testsuite/gfortran.dg/PR82376.f90
new file mode 100644 (file)
index 0000000..07143ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR82376.f90
@@ -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" } }