[gcc r10-9919] Fortran: Fix double function call with -fcheck=pointer [PR]

[gcc r10-9919] Fortran: Fix double function call with -fcheck=pointer [PR]

[José Rui Faustino de Sousa]

https://gcc.gnu.org/g:ec6d6554da7771519f39fee32c97707698dbe50a

commit r10-9919-gec6d6554da7771519f39fee32c97707698dbe50a
Author: José Rui Faustino de Sousa <jrfsousa@gmail.com>
Date:   Wed Jun 16 00:55:37 2021 +0000

    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:
---
 gcc/fortran/trans-expr.c              |  7 ++---
 gcc/testsuite/gfortran.dg/PR82376.f90 | 59 +++++++++++++++++++++++++++++++++++
 2 files changed, 61 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e35f3147a8e..a12cd2fde5a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5958,11 +5958,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
index 00000000000..07143ab7e82
--- /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" } }