]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Constructors with PDT components did not work [PR82843]
authorPaul Thomas <pault@gcc.gnu.org>
Thu, 28 Aug 2025 07:17:14 +0000 (08:17 +0100)
committerPaul Thomas <pault@gcc.gnu.org>
Thu, 28 Aug 2025 07:17:14 +0000 (08:17 +0100)
2025-08-28  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/82843
* intrinsic.cc (gfc_convert_type_warn): If the 'from_ts' is a
PDT instance, copy the derived type to the target ts.
* resolve.cc (gfc_resolve_ref): A PDT component in a component
reference can be that of the pdt_template. Unconditionally use
component of the PDT instance to ensure that the backend_decl
is set during translation. Likewise if a component is
encountered that is a PDT template type, use the component
parmeters to convert to the correct PDT instance.

gcc/testsuite/
PR fortran/82843
* gfortran.dg/pdt_40.f03: New test.

gcc/fortran/intrinsic.cc
gcc/fortran/resolve.cc
gcc/testsuite/gfortran.dg/pdt_40.f03 [new file with mode: 0644]

index e2847f08daae27e560e7cb60b2280f1e297e9f06..a422fc176b4b4715c48e06171344e550ab1d5225 100644 (file)
@@ -5466,6 +5466,9 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag,
   if (ts->type == BT_UNKNOWN)
     goto bad;
 
+  if (from_ts.type == BT_DERIVED && from_ts.u.derived->attr.pdt_type)
+    *ts = from_ts;
+
   expr->do_not_warn = ! wflag;
 
   /* NULL and zero size arrays get their type here, unless they already have a
index 6b01b8f7c2092f8c82b321927fa7dbf0665997ff..d51301aec44fa0ab54da12ee22f4a72cad912e26 100644 (file)
@@ -5880,6 +5880,7 @@ gfc_resolve_ref (gfc_expr *expr)
   int current_part_dimension, n_components, seen_part_dimension, dim;
   gfc_ref *ref, **prev, *array_ref;
   bool equal_length;
+  gfc_symbol *last_pdt = NULL;
 
   for (ref = expr->ref; ref; ref = ref->next)
     if (ref->type == REF_ARRAY && ref->u.ar.as == NULL)
@@ -5927,6 +5928,11 @@ gfc_resolve_ref (gfc_expr *expr)
   n_components = 0;
   array_ref = NULL;
 
+  if (expr->expr_type == EXPR_VARIABLE
+      && expr->symtree->n.sym->ts.type == BT_DERIVED
+      && expr->symtree->n.sym->ts.u.derived->attr.pdt_type)
+    last_pdt = expr->symtree->n.sym->ts.u.derived;
+
   for (ref = expr->ref; ref; ref = ref->next)
     {
       switch (ref->type)
@@ -5984,6 +5990,38 @@ gfc_resolve_ref (gfc_expr *expr)
                }
            }
 
+         /* Sometimes the component in a component reference is that of the
+            pdt_template. Point to the component of pdt_type instead. This
+            ensures that the component gets a backend_decl in translation.  */
+         if (last_pdt)
+           {
+             gfc_component *cmp = last_pdt->components;
+             for (; cmp; cmp = cmp->next)
+               if (!strcmp (cmp->name, ref->u.c.component->name))
+                 {
+                   ref->u.c.component = cmp;
+                   break;
+                 }
+             ref->u.c.sym = last_pdt;
+           }
+
+         /* Convert pdt_templates, if necessary, and update 'last_pdt'.  */
+         if (ref->u.c.component->ts.type == BT_DERIVED)
+           {
+             if (ref->u.c.component->ts.u.derived->attr.pdt_template)
+               {
+                 if (gfc_get_pdt_instance (ref->u.c.component->param_list,
+                                           &ref->u.c.component->ts.u.derived,
+                                           NULL) != MATCH_YES)
+                   return false;
+                 last_pdt = ref->u.c.component->ts.u.derived;
+               }
+             else if (ref->u.c.component->ts.u.derived->attr.pdt_type)
+               last_pdt = ref->u.c.component->ts.u.derived;
+             else
+               last_pdt = NULL;
+           }
+
          n_components++;
          break;
 
diff --git a/gcc/testsuite/gfortran.dg/pdt_40.f03 b/gcc/testsuite/gfortran.dg/pdt_40.f03
new file mode 100644 (file)
index 0000000..4853508
--- /dev/null
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! Contributed by FortranFan at https://groups.google.com/g/comp.lang.fortran/c/NDE6JKTFbNU
+!
+   integer, parameter :: parm = 42
+   type :: t(ell)
+      integer, len :: ell
+      integer :: i
+   end type
+
+   type :: u
+      type(t(ell=:)), allocatable :: x
+   end type
+
+   type(t(ell=:)), allocatable :: foo
+   type(u) :: bar
+
+   allocate( t(ell = parm) :: foo )
+   foo%i = 2 * foo%ell
+
+   bar = u (foo)                    ! Gave: Cannot convert TYPE(Pdtt) to TYPE(t)
+
+   if (bar%x%ell /= parm) stop 1    ! Then these component references failed in
+   if (bar%x%i /= 2 * parm) stop 2  ! translation.
+end