The attached patch is straightforward and sufficiently explained in the ChangeLog and the comment in the patch. Seemingly, the gimplifier objects to an empty loop body emerging from structure_alloc_comps. The ICE arose in the reporter's test case because of the deallocate statement generated in the finalization wrapper. If a similar problem arises elsewhere, the fix might well be refactored by adding another PDT attribute and setting it in decl.cc (gfc_get_pdt_instance) but I see no advantage in doing that now.
Regtest with FC42/x86_64. OK for mainline. Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b11ef57f981..e2b17a725be 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11385,9 +11385,27 @@ gfc_allocate_pdt_comp (gfc_symbol * der_type, tree decl, int rank,
/* Recursively traverse an object of parameterized derived type, generating
code to deallocate parameterized components. */
+static bool
+has_parameterized_comps (gfc_symbol * der_type)
+{
+ /* A type without parameterized components causes gimplifier problems. */
+ bool parameterized_comps = false;
+ for (gfc_component *c = der_type->components; c; c = c->next)
+ if (c->attr.pdt_array || c->attr.pdt_string)
+ parameterized_comps = true;
+ else if (c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.pdt_type
+ && strcmp (der_type->name, c->ts.u.derived->name))
+ parameterized_comps = has_parameterized_comps (c->ts.u.derived);
+ return parameterized_comps;
+}
+
tree
gfc_deallocate_pdt_comp (gfc_symbol * der_type, tree decl, int rank)
{
+ if (!has_parameterized_comps (der_type))
+ return NULL_TREE;
+
return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
DEALLOCATE_PDT_COMP, 0, NULL);
}
diff --git a/gcc/testsuite/gfortran.dg/pdt_59.f03 b/gcc/testsuite/gfortran.dg/pdt_59.f03
new file mode 100644
index 00000000000..7367897c8e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_59.f03
@@ -0,0 +1,47 @@
+! { dg-do compile }
+!
+! Test the fix for PR122191, which used to ICE in compilation.
+!
+! Contributed by Damian Rouson <[email protected]>
+!
+module input_output_pair_m
+ implicit none
+
+ type input_output_pair_t(k)
+ integer, kind :: k
+ integer :: a, b
+ end type
+
+ type mini_batch_t(k)
+ integer, kind :: k = kind(1.)
+ type(input_output_pair_t(k)), allocatable :: input_output_pairs_(:)
+ end type
+
+ interface
+
+ module function default_real_construct()
+ implicit none
+ type(mini_batch_t) default_real_construct
+ end function
+
+ end interface
+
+end module
+
+submodule(input_output_pair_m) input_output_pair_smod
+contains
+ function default_real_construct()
+ type(mini_batch_t) default_real_construct
+ allocate (default_real_construct%input_output_pairs_(2))
+ default_real_construct%input_output_pairs_%a = [42,43]
+ default_real_construct%input_output_pairs_%b = [420,421]
+ end
+end submodule
+
+ use input_output_pair_m
+ type(mini_batch_t), allocatable :: res
+ res = default_real_construct()
+ if (any (res%input_output_pairs_%a /= [42,43])) stop 1
+ if (any (res%input_output_pairs_%b /= [420,421])) stop 2
+ if (allocated (res)) deallocate (res)
+end
