Hello Mikael, Please find the patch attached, which BTW is what I normally do :-)
Cheers Paul On Wed, 2 Sept 2026 at 16:14, Mikael Morin <[email protected]> wrote: > > Le 02/09/2026 à 12:36, Paul Richard Thomas a écrit : > > From dfe5dc0c689c316413090e2bbdecf8a32b508778 Mon Sep 17 00:00:00 2001 > > From: Paul Thomas <[email protected]> > > Date: Wed, 2 Sep 2026 11:12:23 +0100 > > Subject: [PATCH] Fortran: Fix ex-module inherited PDT parameter namespaces > > [PR104750] > > > > Inherited PDT type specification parameters currently become unavailable > > after USE association. > > > > This patch delays reconstruction of PDT parameter namespaces until module > > loading is complete. The named symtree entries for PDT parameters are > > restored, and inherited formal parameters are now correctly skipped when > > locating parameters declared in an extended PDT. > > > > The original version of the patch was assisted by ChatGPT. However, > > the submitter has revamped it such that the LLM input is minimal. I > > can add the attribution, if desired. > > > > Regression tested on FC44/x86_64 - OK for mainline and later for 16-branch? > > > > Cheers > > > > Paul > > > Hello Paul, the patch appears mangled here. > Can you resend it as attachment?
From dfe5dc0c689c316413090e2bbdecf8a32b508778 Mon Sep 17 00:00:00 2001 From: Paul Thomas <[email protected]> Date: Wed, 2 Sep 2026 11:12:23 +0100 Subject: [PATCH] Fortran: Fix ex-module inherited PDT parameter namespaces [PR104750] Inherited PDT type specification parameters currently become unavailable after USE association. This patch delays reconstruction of PDT parameter namespaces until module loading is complete. The named symtree entries for PDT parameters are restored, and inherited formal parameters are now correctly skipped when locating parameters declared in an extended PDT. The original version of the patch was assisted by ChatGPT. However, the submitter has revamped it such the LLM input is minimal. 2026-09-02 Amir Shahmoradi <[email protected]> Paul Thomas <[email protected]> gcc/fortran PR fortran/104750 * module.cc (mio_full_f2k_derived) : Instead of transferring the sym_root from the formal namespace, call mio_f2k_derived so that all required symbols and references are fully loaded. (read_cleanup): Restore named symtree entries for referenced PDT type specification parameters during module cleanup, while preserving existing handling for ordinary hidden symbols and ignoring formal parameters without namespaces. (fixup_pdt_parameter_namespaces): A new function that transfers the namespace of locally declared PDT type specification parms to the derived-type namespace after skipping inherited parameters, preserving the existing namespace ownership and ref counting. (read_module): Call the new fcn after read_cleanup, so that the required symbol and formal-parameter information has been fully reconstructed first. gcc/testsuite PR fortran/104750 * gfortran.dg/pdt_93.f90: New test. --- gcc/fortran/module.cc | 101 ++++++++++++---- gcc/testsuite/gfortran.dg/pdt_93.f90 | 165 +++++++++++++++++++++++++++ 2 files changed, 243 insertions(+), 23 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pdt_93.f90 diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index b79db02a30c..f0101de049e 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -4353,6 +4353,7 @@ mio_f2k_derived (gfc_namespace *f2k) mio_rparen (); } + static void mio_full_f2k_derived (gfc_symbol *sym) { @@ -4367,24 +4368,10 @@ mio_full_f2k_derived (gfc_symbol *sym) { if (peek_atom () != ATOM_RPAREN) { - gfc_namespace *ns; - sym->f2k_derived = gfc_get_namespace (NULL, 0); - /* PDT templates make use of the mechanisms for formal args - and so the parameter symbols are stored in the formal - namespace. Transfer the sym_root to f2k_derived and then - free the formal namespace since it is unneeded. */ - if (sym->attr.pdt_template && sym->formal && sym->formal->sym) - { - ns = sym->formal->sym->ns; - sym->f2k_derived->sym_root = ns->sym_root; - ns->sym_root = NULL; - ns->refs++; - gfc_free_namespace (ns); - ns = NULL; - } - + /* PDT type-parameter namespaces are reconstructed + after all needed module symbols are loaded. */ mio_f2k_derived (sym->f2k_derived); } else @@ -5711,25 +5698,37 @@ read_cleanup (pointer_info *p) read_cleanup (p->left); read_cleanup (p->right); - if (p->type == P_SYMBOL && p->u.rsym.state == USED && !p->u.rsym.referenced) + if (p->type == P_SYMBOL && p->u.rsym.state == USED + && (!p->u.rsym.referenced + || (p->u.rsym.sym && (p->u.rsym.sym->attr.pdt_kind + || p->u.rsym.sym->attr.pdt_len)))) { gfc_namespace *ns; - /* Add hidden symbols to the symtree. */ + + /* Add hidden symbols and PDT parameters to the symtree. */ q = get_integer (p->u.rsym.ns); ns = (gfc_namespace *) q->u.pointer; - if (!p->u.rsym.sym->attr.vtype - && !p->u.rsym.sym->attr.vtab) - st = gfc_get_unique_symtree (ns); - else + /* PDT parameters have no namespace so return. */ + if (ns == NULL) + { + gcc_assert (p->u.rsym.sym->attr.pdt_kind + || p->u.rsym.sym->attr.pdt_len); + return; + } + + if (p->u.rsym.sym->attr.pdt_kind || p->u.rsym.sym->attr.pdt_len + || p->u.rsym.sym->attr.vtype || p->u.rsym.sym->attr.vtab) { /* There is no reason to use 'unique_symtrees' for vtabs or vtypes - their name is fine for a symtree and reduces the - namespace pollution. */ + namespace pollution. PDT parameters need their source name. */ st = gfc_find_symtree (ns->sym_root, p->u.rsym.sym->name); if (!st) st = gfc_new_symtree (&ns->sym_root, p->u.rsym.sym->name); } + else + st = gfc_get_unique_symtree (ns); st->n.sym = p->u.rsym.sym; st->n.sym->refs++; @@ -5746,6 +5745,58 @@ read_cleanup (pointer_info *p) } +/* Reconstruct PDT parameter namespaces after all needed module symbols have + been loaded. read_cleanup installs named symtrees for the type-parameter + symbols first. */ + +static void +fixup_pdt_parameter_namespaces (pointer_info *p) +{ + gfc_symbol *sym; + gfc_formal_arglist *f, *fp; + gfc_namespace *ns; + gfc_symbol *super; + + if (p == NULL) + return; + + fixup_pdt_parameter_namespaces (p->left); + fixup_pdt_parameter_namespaces (p->right); + + if (p->type != P_SYMBOL || p->u.rsym.state != USED) + return; + + sym = p->u.rsym.sym; + if (sym == NULL + || !sym->attr.pdt_template + || sym->f2k_derived == NULL + || sym->f2k_derived->sym_root != NULL) + return; + +/* Transfer the sym_root of the namespace containing locally-declared PDT + type-parameter symbols to that the derived type's namespace. */ + if (sym == NULL || !sym->attr.pdt_template || sym->f2k_derived == NULL + || sym->f2k_derived->sym_root != NULL) + return; + + f = sym->formal; + super = gfc_get_derived_super_type (sym); + if (super && super->attr.pdt_template) + for (fp = super->formal; fp && f; fp = fp->next) + f = f->next; + + if (f == NULL || f->sym == NULL || f->sym->ns == NULL + || f->sym->ns->sym_root == NULL) + return; + + ns = f->sym->ns; + sym->f2k_derived->sym_root = ns->sym_root; + ns->sym_root = NULL; + ns->refs++; + gfc_free_namespace (ns); +} + + /* It is not quite enough to check for ambiguity in the symbols by the loaded symbol and the new symbol not being identical. */ static bool @@ -6303,6 +6354,10 @@ read_module (void) to hidden symbols. */ read_cleanup (pi_root); + + /* Reconstruct PDT type-parameter namespaces now that inherited + and local formal parameter lists have been loaded completely. */ + fixup_pdt_parameter_namespaces (pi_root); } diff --git a/gcc/testsuite/gfortran.dg/pdt_93.f90 b/gcc/testsuite/gfortran.dg/pdt_93.f90 new file mode 100644 index 00000000000..c98c50c41ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_93.f90 @@ -0,0 +1,165 @@ + ! { dg-do run } +! +! Test the fix for pr104750, in which PDT extension outside the module of the +! parent type led to the errors: +! 52 | integer(IKP) :: ivalc1 +! | 1 +! Error: Parameter ‘ikp’ at (1) has not been declared or is +! a variable, which does not reduce to a constant expression. +! pdt_93_exmodext.f90:47:13: +! +! 54 | real(RKP) :: rvalc1 +! | 1 +! Produces the same error message, followed by the fallout errors. +! +! Contributed by Amir Shahmoradi <[email protected]> +! +module mod_grandparent + + integer, parameter :: IK = kind(1) + integer, parameter :: LK = kind(.true.) + integer, parameter :: RKS = kind(1.e0) + integer, parameter :: RKD = kind(1.d0) + + type, abstract :: pdt_grandparent(LKGP) + integer, kind :: LKGP = kind(.true.) + logical(LKGP) :: lvalgp + end type + +end module + +module mod_parent + + use mod_grandparent, only: pdt_grandparent + use mod_grandparent, only: IK, LK, RKS, RKD + + type, extends(pdt_grandparent) :: pdt_parent(IKP, RKP) + integer, kind :: IKP = IK + integer, kind :: RKP + integer(IKP) :: ivalp + real(RKP) :: rvalp + end type + +end module + +module mod_child + + use mod_parent, only: pdt_parent + use mod_parent, only: IK, LK, RKS, RKD + + type, extends(pdt_parent) :: pdt_child(IKC, RKC) + integer, kind :: IKC, RKC + integer(IKP) :: ivalc1 + integer(IKC) :: ivalc2 + real(RKP) :: rvalc1 + real(RKC) :: rvalc2 + end type + + interface pdt_child + module procedure :: pdt_child_getter + end interface + +contains + + pure function pdt_child_getter(lvalgp, ivalp, rvalp, ivalc1, ivalc2, rvalc1, rvalc2) result(child) + type(pdt_child(RKP = RKS, IKC = IK, RKC = RKD)) :: child + logical(LK), intent(in), optional :: lvalgp + integer(IK), intent(in), optional :: ivalp + real(RKS), intent(in), optional :: rvalp + integer(IK), intent(in), optional :: ivalc1 + integer(IK), intent(in), optional :: ivalc2 + real(RKS), intent(in), optional :: rvalc1 + real(RKD), intent(in), optional :: rvalc2 + if (present(lvalgp)) child%lvalgp = lvalgp + if (present(ivalp)) child%ivalp = ivalp + if (present(rvalp)) child%rvalp = rvalp + if (present(ivalc1)) child%ivalc1 = ivalc1 + if (present(ivalc2)) child%ivalc2 = ivalc2 + if (present(rvalc1)) child%rvalc1 = rvalc1 + if (present(rvalc2)) child%rvalc2 = rvalc2 + end function + +end module + +module mod_grandchild + + use mod_child, only: pdt_child + use mod_child, only: IK, LK, RKS, RKD + + type, extends(pdt_child) :: pdt_grandchild(IKGC, RKGC) + integer, kind :: IKGC, RKGC + integer(IKP) :: ivalgc1 + integer(IKC) :: ivalgc2 + integer(IKGC) :: ivalgc3 + real(RKP) :: rvalgc1 + real(RKC) :: rvalgc2 + real(RKGC) :: rvalgc3 + end type + +end module + +program test_pdt_extension + + use mod_child, only: pdt_child + use mod_grandchild, only: pdt_grandchild + use mod_grandchild, only: IK, LK, RKS, RKD + + implicit none + + type(pdt_grandchild(RKP = RKS, IKC = IK, RKC = RKD, IKGC = IK, RKGC = RKD)) :: gc + + gc%ivalp = 1 + gc%rvalp = 1 + + gc%ivalc1 = 2 + gc%ivalc2 = 2 + gc%rvalc1 = 2 + gc%rvalc2 = 2 + + gc%ivalgc1 = 3 + gc%ivalgc2 = 3 + gc%ivalgc3 = 3 + gc%rvalgc1 = 3 + gc%rvalgc2 = 3 + gc%rvalgc3 = 3 + + !!!! + !!!! Ensure components are assigned correctly. + !!!! + + if (gc%ivalp /= gc%rvalp) stop 1 + + if (gc%ivalc1 /= gc%ivalc2) stop 2 + if (gc%ivalc1 /= gc%rvalc1) stop 3 + if (gc%ivalc1 /= gc%rvalc2) stop 4 + + if (gc%ivalgc1 /= gc%ivalgc2) stop 5 + if (gc%ivalgc1 /= gc%ivalgc3) stop 6 + if (gc%ivalgc1 /= gc%rvalgc1) stop 7 + if (gc%ivalgc1 /= gc%rvalgc2) stop 8 + if (gc%ivalgc1 /= gc%rvalgc3) stop 9 + + block + + use mod_child, only: pdt_child + + !!!! + !!!! Custom Constructor: Ensure whole PDT assignment through parental access works. + !!!! + + gc%pdt_child = pdt_child( ivalc1 = -2_IK & + , lvalgp = .false._LK & + , ivalc2 = -2_IK & + , rvalc1 = -2._RKS & + , rvalc2 = -2._RKD & + ) + + if (gc%pdt_child%lvalgp .neqv. .false.) stop 10 + if (gc%ivalc1 /= -2) stop 11 + if (gc%ivalc2 /= -2) stop 12 + if (gc%rvalc1 /= -2) stop 13 + if (gc%rvalc2 /= -2) stop 14 + + end block + +end program -- 2.55.0
