procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Paul Thomas 2024-10-25 17:59:03 +01:00
parent 68e7ced1c7
commit 6cb1da72ca
4 changed files with 46 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/decl.cc
View file

@ -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)

2
gcc/fortran/match.h
View file

@ -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);

8
gcc/fortran/primary.cc
View file

@ -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)

37
gcc/testsuite/gfortran.dg/use_rename_13.f90 Normal file
View file

@ -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