TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 23:25:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Regression in gfc_convert_to_structure_constructor [PR93832]

Browse Source 
2026-03-16  Paul Thomas  <pault@gcc.gnu.org>
	    Steve Kargl  <kargls@comcast.net>

gcc/fortran
	PR fortran/93832
	* array.cc (resolve_array_bound): Emit error and return false
	if bound expression is derived type or class.
	* primary.cc (gfc_convert_to_structure_constructor): Do not
	dereference NULL in character component test. Define 'shorter'
	and use it help cure one of several whitespace issues.

gcc/testsuite/
	PR fortran/93832
	* gfortran.dg/pr93832.f90: New test.
This commit is contained in:
Paul Thomas
2026-03-16 08:20:20 +00:00
parent c523f2a33b
commit 37950565de
3 changed files with 61 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/array.cc
View File

@@ -471,6 +471,13 @@ resolve_array_bound (gfc_expr *e, int check_constant)
if (e == NULL)
return true;
if (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
{
gfc_error ("Derived type or class expression for array bound at %L",
&e->where);
return false;
}
if (!gfc_resolve_expr (e)
|| !gfc_specification_expr (e))
return false;

33
gcc/fortran/primary.cc
View File

@@ -3604,6 +3604,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
&& this_comp->ts.u.cl && this_comp->ts.u.cl->length
&& this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
&& this_comp->ts.u.cl->length->ts.type == BT_INTEGER
&& actual->expr
&& actual->expr->ts.type == BT_CHARACTER
&& actual->expr->expr_type == EXPR_CONSTANT)
{
@@ -3668,27 +3669,27 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
goto cleanup;
}
/* If not explicitly a parent constructor, gather up the components
and build one. */
if (comp && comp == sym->components
&& sym->attr.extension
&& comp_tail->val
&& (!gfc_bt_struct (comp_tail->val->ts.type)
||
comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
{
bool m;
/* If not explicitly a parent constructor, gather up the components
and build one. */
if (comp && comp == sym->components
&& sym->attr.extension
&& comp_tail->val
&& (!gfc_bt_struct (comp_tail->val->ts.type)
|| comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
{
bool m;
gfc_actual_arglist *arg_null = NULL;
actual->expr = comp_tail->val;
comp_tail->val = NULL;
#define shorter gfc_convert_to_structure_constructor
m = shorter (NULL, comp->ts.u.derived, &comp_tail->val,
comp->ts.u.derived->attr.zero_comp ? &arg_null :
&actual, true);
#undef shorter
m = gfc_convert_to_structure_constructor (NULL,
comp->ts.u.derived, &comp_tail->val,
comp->ts.u.derived->attr.zero_comp
? &arg_null : &actual, true);
if (!m)
goto cleanup;
if (!m)
goto cleanup;
if (comp->ts.u.derived->attr.zero_comp)
{

37
gcc/testsuite/gfortran.dg/pr93832.f90 Normal file
View File

@@ -0,0 +1,37 @@
module m
contains
subroutine comment0
type t
character :: a
integer :: b
integer :: c(t(1)) ! { dg-error "No initializer for component .b." }
end type
type(t) :: z = t('a', 2, [3]) ! { dg-error "Bad array spec of component .c." }
end
subroutine comment3a
type t
character :: a
integer :: b
integer :: c(t(1, "rubbish")) ! { dg-error "No initializer for component .c." }
end type
type(t) :: z = t('a', 2, [3]) ! { dg-error "Bad array spec of component .c." }
end
subroutine comment3b
type t
character :: a
integer :: b
integer :: c(t(1, "rubbish", [7])) ! { dg-error "Derived type or class expression" }
end type
type(t) :: z = t('a', 2, [3]) ! { dg-error "Bad array spec of component .c." }
end
subroutine comment9
type t
character :: a
integer :: b(t(1)) ! { dg-error "No initializer for component .b." }
end type
type(t) :: x = t('a', 2)
end
end module