Hi All, The attached is a straightforward fix for a problem with PDT class components of a non parameterised derived type. The ICE is fixed by finding the PDT instance and building the class type just before the ICE occurred (gcc_assert (vtab);).
Note that, in common with a number of other PDT testcases, the allocation in line 22 of the submitted test loses memory (PR121972). I will be turning to this soon. Regtests on FC43/x86_64. OK for mainline? Regards Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index dfedb962bad..9cb9bfae1d8 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4023,6 +4023,11 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
if (!pdt->attr.use_assoc && !c1)
goto error_return;
+ /* Resolution PDT class components of derived types are handled here.
+ They can arrive without a parameter list and no KIND parameters. */
+ if (!param_list && (!c1->attr.pdt_kind && !c1->initializer))
+ continue;
+
kind_expr = NULL;
if (!name_seen)
{
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index db6b52f3076..153ff42f290 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17628,6 +17628,22 @@ resolve_fl_derived (gfc_symbol *sym)
gfc_component *data = gfc_find_component (sym, "_data", true, true, NULL);
gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true, NULL);
+ if (data->ts.u.derived->attr.pdt_template)
+ {
+ match m;
+ m = gfc_get_pdt_instance (sym->param_list, &data->ts.u.derived,
+ &data->param_list);
+ if (m != MATCH_YES
+ || !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
+ {
+ gfc_error ("Failed to build PDT class component at %L",
+ &sym->declared_at);
+ return false;
+ }
+ data = gfc_find_component (sym, "_data", true, true, NULL);
+ vptr = gfc_find_component (sym, "_vptr", true, true, NULL);
+ }
+
/* Nothing more to do for unlimited polymorphic entities. */
if (data->ts.u.derived->attr.unlimited_polymorphic)
{
@@ -17639,7 +17655,7 @@ resolve_fl_derived (gfc_symbol *sym)
gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
gcc_assert (vtab);
vptr->ts.u.derived = vtab->ts.u.derived;
- if (!resolve_fl_derived0 (vptr->ts.u.derived))
+ if (vptr->ts.u.derived && !resolve_fl_derived0 (vptr->ts.u.derived))
return false;
}
}
diff --git a/gcc/testsuite/gfortran.dg/pdt_75.f03 b/gcc/testsuite/gfortran.dg/pdt_75.f03
new file mode 100644
index 00000000000..627c0f0de80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_75.f03
@@ -0,0 +1,63 @@
+! { dg-do run }
+!
+! Test the fix for PR110012, which failed to compile with an ICE.
+!
+! Contributed by Neil Carlson <[email protected]>
+!
+module pde_class
+ type, abstract :: pde(npde)
+ integer,len :: npde
+ end type
+end module
+
+module navier_stokes_type
+ use pde_class
+ type, extends(pde) :: navier_stokes
+ integer, allocatable :: data_(:)
+ end type
+contains
+ subroutine alloc_navier_stokes(p , n)
+ class(pde(:)), allocatable :: p
+ integer :: n
+ allocate(navier_stokes(npde=n) :: p)
+ select type (p)
+ type is (navier_stokes(*))
+ p%data_ = [(i, i = 1, p%npde)]
+ end select
+ end subroutine
+end module
+
+module mfe_disc_type
+ use pde_class
+ type :: foo
+ class(pde(:)), allocatable :: p ! This caused the ICE in resolution.
+ end type
+end module
+
+program test
+ call navier_stokes_test
+ call mfe_disc_test
+contains
+ subroutine navier_stokes_test
+ use navier_stokes_type
+ class (pde(:)), allocatable :: x
+ call alloc_navier_stokes (x, 4)
+ select type (x)
+ type is (navier_stokes(*))
+ if (any (x%data_ /= [1,2,3,4])) stop 1
+ end select
+ end subroutine
+
+ subroutine mfe_disc_test
+ use navier_stokes_type
+ use mfe_disc_type
+ type (foo), allocatable :: x
+ allocate (x)
+ call alloc_navier_stokes (x%p, 3)
+ select type (z => x%p)
+ type is (navier_stokes(*))
+ if (any (z%data_ /= [1,2,3])) stop 2
+ end select
+ if (allocated (x) .and. allocated (x%p)) deallocate (x%p)
+ end subroutine
+end program
