From a3f1cdd8ed46f9816b31ab162ae4dac547d34ebc Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 9 Aug 2024 12:47:18 +0200
Subject: Add corank to gfc_expr.

Compute the corank of an expression along side to the regular rank.
This safe costly calls to gfc_get_corank (), which consecutively has
been removed.  In some locations the code needed some adaption to model
the difference between expr.corank and gfc_get_corank correctly.  The
latter always returned the codimension of the expression and not its
current corank, i.e. the resolution of all indezes.

This commit is preparatory to fixing PR fortran/110033 and may contain
parts of that fix already.

gcc/fortran/ChangeLog:

	* arith.cc (reduce_unary): Use expr.corank.
	(reduce_binary_ac): Same.
	(reduce_binary_ca): Same.
	(reduce_binary_aa): Same.
	* array.cc (gfc_match_array_ref): Same.
	* check.cc (dim_corank_check): Same.
	(gfc_check_move_alloc): Same.
	(gfc_check_image_index): Same.
	* class.cc (gfc_add_class_array_ref): Same.
	(finalize_component): Same.
	* data.cc (gfc_assign_data_value): Same.
	* decl.cc (match_clist_expr): Same.
	(add_init_expr_to_sym): Same.
	* expr.cc (simplify_intrinsic_op): Same.
	(simplify_parameter_variable): Same.
	(gfc_check_assign_symbol): Same.
	(gfc_get_variable_expr): Same.
	(gfc_add_full_array_ref): Same.
	(gfc_lval_expr_from_sym): Same.
	(gfc_get_corank): Removed.
	* frontend-passes.cc (callback_reduction): Use expr.corank.
	(create_var): Same.
	(combine_array_constructor): Same.
	(optimize_minmaxloc): Same.
	* gfortran.h (gfc_get_corank): Add corank to gfc_expr.
	* intrinsic.cc (gfc_get_intrinsic_function_symbol): Use
	expr.corank.
	(gfc_convert_type_warn): Same.
	(gfc_convert_chartype): Same.
	* iresolve.cc (resolve_bound): Same.
	(gfc_resolve_cshift): Same.
	(gfc_resolve_eoshift): Same.
	(gfc_resolve_logical): Same.
	(gfc_resolve_matmul): Same.
	* match.cc (copy_ts_from_selector_to_associate): Same.
	* matchexp.cc (gfc_get_parentheses): Same.
	* parse.cc (parse_associate): Same.
	* primary.cc (gfc_match_rvalue): Same.
	* resolve.cc (resolve_structure_cons): Same.
	(resolve_actual_arglist): Same.
	(resolve_elemental_actual): Same.
	(resolve_generic_f0): Same.
	(resolve_unknown_f): Same.
	(resolve_operator): Same.
	(gfc_expression_rank): Same and set dimen_type for coarray to
	default.
	(gfc_op_rank_conformable): Use expr.corank.
	(add_caf_get_intrinsic): Same.
	(resolve_variable): Same.
	(gfc_fixup_inferred_type_refs): Same.
	(check_host_association): Same.
	(resolve_compcall): Same.
	(resolve_expr_ppc): Same.
	(resolve_assoc_var): Same.
	(fixup_array_ref): Same.
	(resolve_select_type): Same.
	(add_comp_ref): Same.
	(get_temp_from_expr): Same.
	(resolve_fl_var_and_proc): Same.
	(resolve_symbol): Same.
	* symbol.cc (gfc_is_associate_pointer): Same.
	* trans-array.cc (walk_coarray): Same.
	(gfc_conv_expr_descriptor): Same.
	(gfc_walk_array_ref): Same.
	* trans-array.h (gfc_walk_array_ref): Same.
	* trans-expr.cc (gfc_get_ultimate_alloc_ptr_comps_caf_token):
	Same.
	* trans-intrinsic.cc (trans_this_image): Same.
	(trans_image_index): Same.
	(conv_intrinsic_cobound): Same.
	(gfc_walk_intrinsic_function): Same.
	(conv_intrinsic_move_alloc): Same.
	* trans-stmt.cc (gfc_trans_lock_unlock): Same.
	(trans_associate_var): Same and adapt to slightly different
	behaviour of expr.corank and gfc_get_corank.
	(gfc_trans_allocate): Same.
	* trans.cc (gfc_add_finalizer_call): Same.
---
 gcc/fortran/iresolve.cc | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

(limited to 'gcc/fortran/iresolve.cc')

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index c63a4a8..753c636 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -152,13 +152,21 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
 
   if (dim == NULL)
     {
-      f->rank = 1;
       if (array->rank != -1)
 	{
-	  f->shape = gfc_get_shape (1);
-	  mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
-						: array->rank);
+	  /* Assume f->rank gives the size of the shape, because there is no
+	     other way to determine the size.  */
+	  if (!f->shape || f->rank != 1)
+	    {
+	      if (f->shape)
+		gfc_free_shape (&f->shape, f->rank);
+	      f->shape = gfc_get_shape (1);
+	    }
+	  mpz_init_set_ui (f->shape[0], coarray ? array->corank : array->rank);
 	}
+      /* Applying bound to a coarray always results in a regular array.  */
+      f->rank = 1;
+      f->corank = 0;
     }
 
   f->value.function.name = gfc_get_string ("%s", name);
@@ -748,6 +756,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 
   f->ts = array->ts;
   f->rank = array->rank;
+  f->corank = array->corank;
   f->shape = gfc_copy_shape (array->shape, array->rank);
 
   if (shift->rank > 0)
@@ -916,6 +925,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 
   f->ts = array->ts;
   f->rank = array->rank;
+  f->corank = array->corank;
   f->shape = gfc_copy_shape (array->shape, array->rank);
 
   n = 0;
@@ -1554,6 +1564,7 @@ gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
   f->ts.kind = (kind == NULL)
 	     ? gfc_default_logical_kind : mpz_get_si (kind->value.integer);
   f->rank = a->rank;
+  f->corank = a->corank;
 
   f->value.function.name
     = gfc_get_string ("__logical_%d_%c%d", f->ts.kind,
@@ -1584,6 +1595,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
     }
 
   f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
+  f->corank = a->corank;
 
   if (a->rank == 2 && b->rank == 2)
     {
-- 
cgit v1.1