Fortran: Generate new charlens for shared symbol typespecs [PR89462]

2024-04-25  Paul Thomas  <pault@gcc.gnu.org>
	    Jakub Jelinek  <jakub@gcc.gnu.org>

gcc/fortran
	PR fortran/89462
	* decl.cc (build_sym): Add an extra argument 'elem'. If 'elem'
	is greater than 1, gfc_new_charlen is called to generate a new
	charlen, registered in the symbol namespace.
	(variable_decl, enumerator_decl): Set the new argument in the
	calls to build_sym.

gcc/testsuite/
	PR fortran/89462
	* gfortran.dg/pr89462.f90: New test.
This commit is contained in:
Paul Thomas 2024-04-25 06:52:31 +01:00
parent 09680e3ee7
commit 1fd5a07444
2 changed files with 20 additions and 4 deletions

View file

@ -1713,7 +1713,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
/* Function called by variable_decl() that adds a name to the symbol table. */
static bool
build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred,
gfc_array_spec **as, locus *var_locus)
{
symbol_attribute attr;
@ -1778,7 +1778,10 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
if (sym->ts.type == BT_CHARACTER)
{
sym->ts.u.cl = cl;
if (elem > 1)
sym->ts.u.cl = gfc_new_charlen (sym->ns, cl);
else
sym->ts.u.cl = cl;
sym->ts.deferred = cl_deferred;
}
@ -2960,7 +2963,7 @@ variable_decl (int elem)
create a symbol for those yet. If we fail to create the symbol,
bail out. */
if (!gfc_comp_struct (gfc_current_state ())
&& !build_sym (name, cl, cl_deferred, &as, &var_locus))
&& !build_sym (name, elem, cl, cl_deferred, &as, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;
@ -10938,7 +10941,7 @@ enumerator_decl (void)
/* OK, we've successfully matched the declaration. Now put the
symbol in the current namespace. If we fail to create the symbol,
bail out. */
if (!build_sym (name, NULL, false, &as, &var_locus))
if (!build_sym (name, 1, NULL, false, &as, &var_locus))
{
m = MATCH_ERROR;
goto cleanup;

View file

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-pedantic-errors" }
! Test the fix for PR89462 in which the shared 'cl' field of the typespec
! shared between 'test', 'TR' and 'aTP' caused the compiler to go into an
! infinite loop.
! Contributed by Sergei Trofimovich <slyich@gmail.com>
CHARACTER*1 FUNCTION test(H) ! { dg-warning "Old-style character length" }
CHARACTER*1 test2,TR,aTP ! { dg-warning "Old-style character length" }
ENTRY test2(L)
CALL ttest3(aTP)
test = TR
RETURN
END