From: José Rui Faustino de Sousa <jrfsousa@gmail.com>
Date: Wed, 28 Apr 2021 11:20:25 +0000 (+0000)
Subject: Fortran: Fix double function call with -fcheck=pointer [PR]
X-Git-Tag: basepoints/gcc-13~8099
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=b020cee5af4cb40b9971bfb943d7bd2795b2a3eb;p=thirdparty%2Fgcc.git

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 213f32b0a672..b83b021755d0 100644
--- 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
index 000000000000..07143ab7e82e
--- /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" } }