[Patch, fortran] PR93832 - [13/14/15/16 Regression] ICE in gfc_convert_to_structure_constructor, at fortran/primary.c:3100
Paul Richard Thomas <[email protected]>
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <CAGkQGiJp5-3K_JrKdAqV7KcPqdx1bJdri0_MUc61DdTmokTgdg@mail.gmail.com> |
Hi All, The fix is mostly dues to Steve, as posted in the PR. Chunks 1 and 2 do the fixing and chunk 3 addresses white space issues. I am not entirely happy with some of the error messages but they are considerably better than ICEs. Regtests OK on FC_42/x86_64 - OK for mainline and backporting? Regards Paul
Change.Logs
(application/octet-stream, 510 B) - not displayed
submit.diff
(text/x-patch, 3.9 KB)
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 87b37c8a5dd..705ff17439b 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -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;
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 9251f88d6d6..2ca2c4744bb 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -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)
{
diff --git a/gcc/testsuite/gfortran.dg/pr93832.f90 b/gcc/testsuite/gfortran.dg/pr93832.f90
new file mode 100644
index 00000000000..ca8b4abaa9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93832.f90
@@ -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