This patch is straightforward but I am still puzzled as to why it is
necessary for the particular case. Having looked at all the other chunks of
frontend code involving use renaming, it seems that the process just works
everywhere else. I tried putting the new code in gfc_find_symtree but it
caused some regressions unless I pinned it down to the specific case of a
structure constructor.
OK for mainline and backporting at a later date?
Paul
Fortran: Fix ICE with structure constructor in data statement [PR79685]
2024-07-27 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/79685
* primary.cc (gfc_match_structure_constructor): See if there is
a use renamed symtree before calling gfc_get_ha_sym_tree. If so
use it.
gcc/testsuite/
PR fortran/79685
* gfortran.dg/use_rename_12.f90: New test.
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 76f6bcb8a78..30ea01961a3 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -3524,14 +3524,33 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
{
match m;
gfc_expr *e;
- gfc_symtree *symtree;
+ gfc_symtree *symtree = NULL;
bool t = true;
+ gfc_use_list *use_stmts = gfc_current_ns->use_stmts;
- gfc_get_ha_sym_tree (sym->name, &symtree);
+ /* Check if we have a usable symtree that is use renamed. */
+ for (; use_stmts; use_stmts = use_stmts->next)
+ {
+ if (!use_stmts->rename || use_stmts->rename->use_name[0] == 0)
+ continue;
+
+ if (!strcmp (use_stmts->rename->use_name, sym->name))
+ {
+ symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+ use_stmts->rename->local_name);
+ if (symtree && symtree->name[0] != 0
+ && symtree->n.sym->attr.flavor == FL_PROCEDURE)
+ break;
+ }
+ }
+
+ /* Otherwise find or create the symtree. */
+ if (!symtree)
+ 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_12.f90 b/gcc/testsuite/gfortran.dg/use_rename_12.f90
new file mode 100644
index 00000000000..97f26f42f76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_12.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.reu...@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
+
