https://gcc.gnu.org/bugzilla/show_bug.cgi?id=82943
--- Comment #13 from Alexander Westbrooks <ctechnodev at gmail dot com> ---
I sent in the patch to those emails. Hopefully now the ball will start rolling
and I can slowly get this packaged into a legitimate fix. I'll post updates
here as I receive them.
The patch is below, if you would like to try it. I did this in the GCC 14 code.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d09c8bc97d9..9043a4d427f 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4063,6 +4063,21 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list,
gfc_symbol **sym,
continue;
}
+ /*
+ Addressing PR82943, this will fix the issue where a function/subroutine is
declared as not
+ a member of the PDT instance. The reason for this is because the PDT
instance did not have
+ access to its template's f2k_derived namespace in order to find the
typebound procedures.
+
+ The number of references to the PDT template's f2k_derived will ensure
that f2k_derived is
+ properly freed later on.
+ */
+
+ if (!instance->f2k_derived && pdt->f2k_derived)
+ {
+ instance->f2k_derived = pdt->f2k_derived;
+ instance->f2k_derived->refs++;
+ }
+
/* Set the component kind using the parameterized expression. */
if ((c1->ts.kind == 0 || c1->ts.type == BT_CHARACTER)
&& c1->kind_expr != NULL)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a58c60e9828..6854edb3467 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3536,6 +3536,7 @@ void gfc_traverse_gsymbol (gfc_gsymbol *, void
(*)(gfc_gsymbol *, void *), void
gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
+bool gfc_pdt_is_instance_of(gfc_symbol *, gfc_symbol *);
bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *,
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 50b49d0cb83..6af55760321 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -14705,14 +14705,34 @@ resolve_typebound_procedure (gfc_symtree* stree)
goto error;
}
- if (CLASS_DATA (me_arg)->ts.u.derived
- != resolve_bindings_derived)
- {
- gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
- " the derived-type %qs", me_arg->name, proc->name,
- me_arg->name, &where, resolve_bindings_derived->name);
- goto error;
- }
+ /* The derived type is not a PDT template. Resolve as usual */
+ if ( !resolve_bindings_derived->attr.pdt_template &&
+ (CLASS_DATA (me_arg)->ts.u.derived != resolve_bindings_derived))
+ {
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
+ " the derived-type %qs", me_arg->name, proc->name,
+ me_arg->name, &where, resolve_bindings_derived->name);
+ goto error;
+ }
+
+ if ( resolve_bindings_derived->attr.pdt_template &&
+ !gfc_pdt_is_instance_of(resolve_bindings_derived,
CLASS_DATA(me_arg)->ts.u.derived) )
+ {
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
+ " the parametric derived-type %qs", me_arg->name, proc->name,
+ me_arg->name, &where, resolve_bindings_derived->name);
+ goto error;
+ }
+
+ if ( resolve_bindings_derived->attr.pdt_template
+ && gfc_pdt_is_instance_of(resolve_bindings_derived,
CLASS_DATA(me_arg)->ts.u.derived)
+ && (me_arg->param_list != NULL)
+ && (gfc_spec_list_type(me_arg->param_list,
CLASS_DATA(me_arg)->ts.u.derived) != SPEC_ASSUMED))
+ {
+ gfc_error ("All LEN type parameters of the passed dummy argument %qs of
%qs"
+ " at %L must be ASSUMED.", me_arg->name, proc->name, &where);
+ goto error;
+ }
gcc_assert (me_arg->ts.type == BT_CLASS);
if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank != 0)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 37a9e8fa0ae..77f84de0989 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5134,6 +5134,35 @@ gfc_type_is_extension_of (gfc_symbol *t1, gfc_symbol
*t2)
return gfc_compare_derived_types (t1, t2);
}
+/* Check if a parameterized derived type t2 is an instance of a PDT template
t1 */
+
+bool
+gfc_pdt_is_instance_of(gfc_symbol *t1, gfc_symbol *t2)
+{
+ if ( !t1->attr.pdt_template || !t2->attr.pdt_type )
+ return false;
+
+ /*
+ in decl.cc, gfc_get_pdt_instance, a pdt instance is given a 3 character
prefix "Pdt", followed
+ by an underscore list of the kind parameters, up to a maximum of 8.
+
+ So to check if a PDT Type corresponds to the template, extract the core
derive_type name,
+ and then see if it is type compatible by name...
+
+ For example:
+
+ Pdtf_2_2 -> extract out the 'f' -> see if the derived type 'f' is
compatible with symbol t1
+ */
+
+ // Starting at index 3 of the string in order to skip past the 'Pdt' prefix
+ // Also, here the length of the template name is used in order to avoid the
+ // kind parameter suffixes that are placed at the end of PDT instance names.
+ if ( !(strncmp(&(t2->name[3]), t1->name, strlen(t1->name)) == 0) )
+ return false;
+
+ return true;
+}
+
/* Check if two typespecs are type compatible (F03:5.1.1.2):
If ts1 is nonpolymorphic, ts2 must be the same type.
