diff mbox

[Fortran,pr68218,v1] ALLOCATE with size given by a module function

Message ID 20151105152920.65f52c89@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Nov. 5, 2015, 2:29 p.m. UTC 
Hi all,

attached is a rather trivial patch to prevent multiple evaluations of a
function in:

  allocate( array(func()) )

The patch tests whether the upper bound of the array is a function
and calls gfc_evaluate_now().

Bootstrapped and regtested for x86_64-linux-gnu/f21.

Ok for trunk?

Regards,
	Andre

Comments

Paul Richard Thomas Nov. 7, 2015, 1:58 p.m. UTC | #1 
Dear Andre,

OK for trunk.

I understand that you have investigated the issue(s) reported to you
by Dominique and can find no sign of them.

Thanks

Paul

On 5 November 2015 at 15:29, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> attached is a rather trivial patch to prevent multiple evaluations of a
> function in:
>
>   allocate( array(func()) )
>
> The patch tests whether the upper bound of the array is a function
> and calls gfc_evaluate_now().
>
> Bootstrapped and regtested for x86_64-linux-gnu/f21.
>
> Ok for trunk?
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox

Patch

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6bbf8cc..e28a5ce 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5150,6 +5150,8 @@  gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 	  gcc_assert (ubound);
 	  gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
 	  gfc_add_block_to_block (pblock, &se.pre);
+	  if (ubound->expr_type == EXPR_FUNCTION)
+	    se.expr = gfc_evaluate_now (se.expr, pblock);
 	}
       gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
 				      gfc_rank_cst[n], se.expr);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_arrayspec_1.f90 b/gcc/testsuite/gfortran.dg/allocate_with_arrayspec_1.f90
new file mode 100644
index 0000000..686b612
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_arrayspec_1.f90
@@ -0,0 +1,29 @@ 
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+
+MODULE mo_test
+
+  integer :: n = 0
+CONTAINS
+
+  FUNCTION nquery()
+    INTEGER :: nquery
+    WRITE (0,*) "hello!"
+    n = n + 1
+    nquery = n
+  END FUNCTION nquery
+
+END MODULE mo_test
+
+
+! ----------------------------------------------------------------------
+! MAIN PROGRAM
+! ----------------------------------------------------------------------
+PROGRAM example
+   USE mo_test
+   INTEGER, ALLOCATABLE :: query_buf(:)
+   ALLOCATE(query_buf(nquery()))
+   if (n /= 1 .or. size(query_buf) /= n) call abort()
+END PROGRAM example
+
+! { dg-final { scan-tree-dump-times "nquery" 5 "original" } }