Fortran: Fix ICE with structure constructor in data statement [PR79685]

2024-10-25  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/79685
	* decl.cc (match_data_constant): Find the symtree instead of
	the symbol so the use renamed symbols are found. Pass this and
	the derived type to gfc_match_structure_constructor.
	* match.h: Update prototype of gfc_match_structure_contructor.
	* primary.cc (gfc_match_structure_constructor): Remove call to
	gfc_get_ha_sym_tree and use caller supplied symtree instead.

gcc/testsuite/
	PR fortran/79685
	* gfortran.dg/use_rename_13.f90: New test.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 499a8462629eeb22f36a3b18dd4e4f6720214398..000c8dcf34eddda36dee09c2aa2744e9c3794b9d 100644 (file)
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -377,6 +377,7 @@ match_data_constant (gfc_expr **result)
   gfc_expr *expr;
   match m;
   locus old_loc;
+  gfc_symtree *symtree;
 
   m = gfc_match_literal_constant (&expr, 1);
   if (m == MATCH_YES)
@@ -437,9 +438,11 @@ match_data_constant (gfc_expr **result)
   if (m != MATCH_YES)
     return m;
 
-  if (gfc_find_symbol (name, NULL, 1, &sym))
+  if (gfc_find_sym_tree (name, NULL, 1, &symtree))
     return MATCH_ERROR;
 
+  sym = symtree->n.sym;
+
   if (sym && sym->attr.generic)
     dt_sym = gfc_find_dt_in_generic (sym);
 
@@ -453,7 +456,7 @@ match_data_constant (gfc_expr **result)
       return MATCH_ERROR;
     }
   else if (dt_sym && gfc_fl_struct (dt_sym->attr.flavor))
-    return gfc_match_structure_constructor (dt_sym, result);
+    return gfc_match_structure_constructor (dt_sym, symtree, result);
 
   /* Check to see if the value is an initialization array expression.  */
   if (sym->value->expr_type == EXPR_ARRAY)

diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b2158e12a92f80245eb62d8b280679f6bee513dd..13972bfe3e1043bc83c08912f36bd8aedd296e4e 100644 (file)
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -303,7 +303,7 @@ match gfc_match_bind_c_stmt (void);
 match gfc_match_bind_c (gfc_symbol *, bool);
 
 /* primary.cc.  */
-match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);
+match gfc_match_structure_constructor (gfc_symbol *, gfc_symtree *, gfc_expr **);
 match gfc_match_variable (gfc_expr **, int);
 match gfc_match_equiv_variable (gfc_expr **);
 match gfc_match_actual_arglist (int, gfc_actual_arglist **, bool = false);

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index f3f659cf8dfe32faeb062bb5abf78b30ffabe0a8..0f258edd12940e6824f1cc76684dff21a3bd3e67 100644 (file)
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -3648,18 +3648,16 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
 
 
 match
-gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
+gfc_match_structure_constructor (gfc_symbol *sym, gfc_symtree *symtree,
+                                gfc_expr **result)
 {
   match m;
   gfc_expr *e;
-  gfc_symtree *symtree;
   bool t = true;
 
-  gfc_get_ha_sym_tree (sym->name, &symtree);
-
   e = gfc_get_expr ();
-  e->symtree = symtree;
   e->expr_type = EXPR_FUNCTION;
+  e->symtree = symtree;
   e->where = gfc_current_locus;
 
   gcc_assert (gfc_fl_struct (sym->attr.flavor)

diff --git a/gcc/testsuite/gfortran.dg/use_rename_13.f90 b/gcc/testsuite/gfortran.dg/use_rename_13.f90
new file mode 100644 (file)
index 0000000..97f26f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_13.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! Test the fix for pr79685, which failed as in the comments below.
+!
+! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
+!
+module omega_color
+  implicit none
+
+  type omega_color_factor
+     integer :: i
+  end type
+
+  type(omega_color_factor), parameter :: op = omega_color_factor (199)
+
+end module
+
+module foo
+  use omega_color, ocf => omega_color_factor, ocfp => op
+  implicit none
+
+  type(ocf) :: table_color_factors1 = ocf(42)
+  type(ocf) :: table_color_factors2
+  type(ocf) :: table_color_factors3 (2)
+  type(ocf) :: table_color_factors4
+  data table_color_factors2 / ocf(99) /        ! This failed in gfc_match_structure_constructor.
+  data table_color_factors3 / ocf(1), ocf(2) / ! ditto.
+  data table_color_factors4 / ocfp /
+end module
+
+  use foo
+  if (table_color_factors1%i .ne. 42) stop 1
+  if (table_color_factors2%i .ne. 99) stop 2
+  if (any (table_color_factors3%i .ne. [1,2])) stop 3
+  if (table_color_factors4%i .ne. 199) stop 4
+end
+