[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Correction régression func_result_6.f90

[Mikael Morin via Gcc-cvs]

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

commit bfcf31a399f6e5a095c3208417f14e810c66383a
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Tue Feb 18 19:18:37 2025 +0100

    Correction régression func_result_6.f90

Diff:
---
 gcc/fortran/resolve.cc | 50 ++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index cfbcbf4ca3ca..f211ad187613 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -2799,6 +2799,31 @@ done:
 }
 
 
+static void
+expression_shape (gfc_expr *e, gfc_array_spec *as)
+{
+  mpz_t array[GFC_MAX_DIMENSIONS];
+  int i;
+
+  if (e->rank <= 0 || e->shape != NULL)
+    return;
+
+  for (i = 0; i < e->rank; i++)
+    if (!spec_dimen_size (as, i, &array[i]))
+      goto fail;
+
+  e->shape = gfc_get_shape (e->rank);
+
+  memcpy (e->shape, array, e->rank * sizeof (mpz_t));
+
+  return;
+
+fail:
+  for (i--; i >= 0; i--)
+    mpz_clear (array[i]);
+}
+
+
 /************* Function resolution *************/
 
 /* Resolve a function call known to be generic.
@@ -2822,15 +2847,17 @@ resolve_generic_f0 (gfc_expr *expr, gfc_symbol *sym)
          else if (s->result != NULL && s->result->ts.type != BT_UNKNOWN)
            expr->ts = s->result->ts;
 
-         if (s->as != NULL)
-           {
-             expr->rank = s->as->rank;
-             expr->corank = s->as->corank;
-           }
-         else if (s->result != NULL && s->result->as != NULL)
+         if (s->result != NULL && s->result->as != NULL)
            {
              expr->rank = s->result->as->rank;
              expr->corank = s->result->as->corank;
+             expression_shape (expr, s->result->as);
+           }
+         else if (s->as != NULL)
+           {
+             expr->rank = s->as->rank;
+             expr->corank = s->as->corank;
+             expression_shape (expr, s->as);
            }
 
          gfc_set_sym_referenced (expr->value.function.esym);
@@ -2974,11 +3001,13 @@ found:
     {
       expr->rank = CLASS_DATA (sym)->as->rank;
       expr->corank = CLASS_DATA (sym)->as->corank;
+      expression_shape (expr, CLASS_DATA (sym)->as);
     }
   else if (sym->as != NULL)
     {
       expr->rank = sym->as->rank;
       expr->corank = sym->as->corank;
+      expression_shape (expr, sym->as);
     }
 
   return MATCH_YES;
@@ -3103,6 +3132,7 @@ resolve_unknown_f (gfc_expr *expr)
     {
       expr->rank = sym->as->rank;
       expr->corank = sym->as->corank;
+      expression_shape (expr, sym->as);
     }
 
   /* Type of the expression is either the type of the symbol or the
@@ -3640,11 +3670,6 @@ resolve_function (gfc_expr *expr)
                 "Using function %qs at %L is deprecated",
                 sym->name, &expr->where);
 
-  if (!(expr->value.function.isym
-       || !expr->value.function.esym
-       || expr->value.function.esym->attr.elemental))
-    gfc_expression_rank (expr);
-
   return t;
 }
 
@@ -5893,9 +5918,6 @@ gfc_resolve_ref (gfc_expr *expr)
 }
 
 
-/* Given an expression, determine its shape.  This is easier than it sounds.
-   Leaves the shape array NULL if it is not possible to determine the shape.  
*/
-
 static void
 expression_shape (gfc_expr *e)
 {