Hi Alex,
I've been unable to apply your patch to my local trunk, likely due to
whitespace issues my newsreader handles differently from your site.
I see it inline instead of attached.
A few general remarks:
Please follow the general recommendation regarding style if possible,
see https://www.gnu.org/prep/standards/standards.html#Formatting
regarding formatting/whitespace use (5.1) and comments (5.2)
Also, when an error message text spans multiple lines, please place the
whitespace at the end of a line, not at the beginning of the new one:
+ 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,
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;
+ }
The following change is almost unreadable: the lnegthy comment is split
over three parts and almost hides the code. Couldn't this be combined
into one comment before the function?
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index fddf68f8398..11f4bac0415 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5172,6 +5172,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.
The following testcase tests for errors. I tried Intel and NAG on it
after commenting the 'contains' section of the type desclaration.
Both complained about subroutine deferred_len_param, e.g.
Intel:
A colon may only be used as a type parameter value in the declaration of
an object that has the POINTER or ALLOCATABLE attribute. [THIS]
class(param_deriv_type(:)), intent(inout) :: this
NAG:
Entity THIS of type PARAM_DERIV_TYPE(A=:) has a deferred length type
parameter but is not a data pointer or allocatable
Do we detect this after your patch? If the answer is yes,
can we add another subroutine where we check for this error?
(the dg-error suggests we only expect assumed len type parameters.)
If no, maybe add a comment in the testcase that this subroutine
may need updating later.
diff --git a/gcc/testsuite/gfortran.dg/pdt_37.f03
b/gcc/testsuite/gfortran.dg/pdt_37.f03
new file mode 100644
index 00000000000..68d376fad25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_37.f03
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on the errors produced by incorrect LEN parameters for
dummy
+! arguments of PDT Typebound Procedures.
+!
+! Contributed by Alexander Westbrooks <ctechno...@gmail.com>
+!
+module test_len_param
+
+ type :: param_deriv_type(a)
+ integer, len :: a
+ contains
+ procedure :: assumed_len_param ! Good. No error expected.
+ procedure :: deferred_len_param ! { dg-error "All LEN type
parameters of the passed dummy argument" }
+ procedure :: fixed_len_param ! { dg-error "All LEN type
parameters of the passed dummy argument" }
+ end type
+
+contains
+ subroutine assumed_len_param(this)
+ class(param_deriv_type(*)), intent(inout) :: this
+ end subroutine
+
+ subroutine deferred_len_param(this)
+ class(param_deriv_type(:)), intent(inout) :: this
+ end subroutine
+
+ subroutine fixed_len_param(this)
+ class(param_deriv_type(10)), intent(inout) :: this
+ end subroutine
+
+end module
+
