* [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
@ 2024-02-10 23:27 Alexander Westbrooks
2024-02-11 20:11 ` Harald Anlauf
0 siblings, 1 reply; 7+ messages in thread
From: Alexander Westbrooks @ 2024-02-10 23:27 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 15012 bytes --]
Hello,
I have implemented a patch that fixes compile time errors for valid PDT
type-bound procedures. I wrote 4 new tests that address the test-cases in
PR 82943, PR 86148, and PR 86268, since the patch fixes all three of them.
All regression tests pass, including the new ones. This was tested on WSL
2, with Ubuntu 20.04 distro.
Is this okay to push to the trunk?
Alexander Westbrooks
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
From 100508673ae26d7fa4ae4f976b4542e115fc7b45 Mon Sep 17 00:00:00 2001
From: Alexander Westbrooks <alexanderw@gcc.gnu.org>
Date: Sat, 10 Feb 2024 13:19:08 -0600
Subject: [PATCH] Fortran - Error compiling PDT Type-bound Procedures
[PR82943/86148/86268]
This patch allows parameterized derived types to compile successfully
when typebound procedures are specified in the type specification.
Furthermore, it allows function calls for PDTs by setting the
f2k_derived space of PDT instances to reference their original template,
thereby giving it referential access to the typebound procedures of the
template.
2024-02-10 Alexander Westbrooks <alexanderw@gcc.gnu.org>
gcc/fortran/ChangeLog:
PR fortran/82943
PR fortran/86148
PR fortran/86268
* decl.cc (gfc_get_pdt_instance): Set the PDT instance field
'f2k_derived', if not set already, to point to the given
PDT template 'f2k_derived' namespace in order to give the
PDT instance referential access to the typebound procedures
of the template.
* gfortran.h (gfc_pdt_is_instance_of): Add prototype.
* resolve.cc (resolve_typebound_procedure): If the derived type
does not have the attribute 'pdt_template' set, compare the
dummy argument to the 'resolve_bindings_derived' type like usual.
If the derived type is a 'pdt_template', then check if the
dummy argument is an instance of the PDT template. If the derived
type is a PDT template, and the dummy argument is an instance of
that template, but the dummy argument 'param_list' is not
SPEC_ASSUMED, check if there are any LEN parameters in the
dummy argument. If there are no LEN parameters, then this implies
that there are only KIND parameters in the dummy argument.
If there are LEN parameters, this would be an error, for all
LEN parameters for the dummy argument MUST be assumed for
typebound procedures of PDTs.
* symbol.cc (gfc_pdt_is_instance_of): New function.
gcc/testsuite/ChangeLog:
PR fortran/82943
PR fortran/86148
PR fortran/86268
* gfortran.dg/pdt_34.f03: New test.
* gfortran.dg/pdt_35.f03: New test.
* gfortran.dg/pdt_36.f03: New test.
* gfortran.dg/pdt_37.f03: New test.
Signed-off-by: Alexander Westbrooks <alexanderw@gcc.gnu.org>
---
gcc/fortran/decl.cc | 15 ++++++
gcc/fortran/gfortran.h | 1 +
gcc/fortran/resolve.cc | 68 ++++++++++++++++++++++++----
gcc/fortran/symbol.cc | 29 ++++++++++++
gcc/testsuite/gfortran.dg/pdt_34.f03 | 42 +++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_35.f03 | 45 ++++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_36.f03 | 65 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_37.f03 | 34 ++++++++++++++
8 files changed, 291 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pdt_34.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_35.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_36.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_37.f03
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 503ecb8d9b5..c29b2bb0f45 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4083,6 +4083,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 fd73e4ce431..25ff19a6e44 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3585,6 +3585,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 44f89f6afb4..6de8ac0a307 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -14760,14 +14760,66 @@ 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))
+ {
+
+ /*
+ Add a check to verify if there are any LEN parameters in the first
place.
+ If there are LEN parameters, throw this error. If there are only
KIND
+ parameters, then don't trigger this error.
+ */
+ gfc_component *c;
+ bool seen_len_param = false;
+ gfc_actual_arglist *me_arg_param = me_arg->param_list;
+
+ for (; me_arg_param; me_arg_param = me_arg_param->next)
+ {
+ c = gfc_find_component(
+ CLASS_DATA(me_arg)->ts.u.derived,
+ me_arg_param->name,
+ true, true, NULL);
+
+ gcc_assert (c != NULL);
+ if (c->attr.pdt_kind)
+ continue;
+
+ // Getting here implies that there is a pdt_len parameter in the
list.
+ seen_len_param = true;
+ break;
+ }
+
+ if (seen_len_param)
+ {
+ 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 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.
diff --git a/gcc/testsuite/gfortran.dg/pdt_34.f03
b/gcc/testsuite/gfortran.dg/pdt_34.f03
new file mode 100644
index 00000000000..c601071ba3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_34.f03
@@ -0,0 +1,42 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module m
+ public :: foo, bar, foobar
+
+ type, public :: good_type(n)
+ integer, len :: n = 1
+ contains
+ procedure :: foo
+ end type
+
+ type, public :: good_type2(k)
+ integer, kind :: k = 1
+ contains
+ procedure :: bar
+ end type
+
+ type, public :: good_type3(n, k)
+ integer, len :: n = 1
+ integer, kind :: k = 1
+ contains
+ procedure :: foobar
+ end type
+
+ contains
+ subroutine foo(this)
+ class(good_type(*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(good_type2(2)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(good_type3(*,2)), intent(inout) :: this
+ end subroutine
+
+ end module
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_35.f03
b/gcc/testsuite/gfortran.dg/pdt_35.f03
new file mode 100644
index 00000000000..8b99948fa73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_35.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on inheritance for the type bound procedures.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module m
+
+ public :: foo, bar, foobar
+
+ type, public :: goodpdt_lvl_0(a, b)
+ integer, kind :: a = 1
+ integer, len :: b
+ contains
+ procedure :: foo
+ end type
+
+ type, public, EXTENDS(goodpdt_lvl_0) :: goodpdt_lvl_1 (c)
+ integer, len :: c
+ contains
+ procedure :: bar
+ end type
+
+ type, public, EXTENDS(goodpdt_lvl_1) :: goodpdt_lvl_2 (d)
+ integer, len :: d
+ contains
+ procedure :: foobar
+ end type
+
+contains
+ subroutine foo(this)
+ class(goodpdt_lvl_0(1,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(goodpdt_lvl_1(1,*,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(goodpdt_lvl_2(1,*,*,*)), intent(inout) :: this
+ end subroutine
+
+end module
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_36.f03
b/gcc/testsuite/gfortran.dg/pdt_36.f03
new file mode 100644
index 00000000000..a351c0e4f8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_36.f03
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on calling the type bound procedures in a program.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module testmod
+
+ public :: foo
+
+ type, public :: tough_lvl_0(a, b)
+ integer, kind :: a = 1
+ integer, len :: b
+ contains
+ procedure :: foo
+ end type
+
+ type, public, EXTENDS(tough_lvl_0) :: tough_lvl_1 (c)
+ integer, len :: c
+ contains
+ procedure :: bar
+ end type
+
+ type, public, EXTENDS(tough_lvl_1) :: tough_lvl_2 (d)
+ integer, len :: d
+ contains
+ procedure :: foobar
+ end type
+
+contains
+ subroutine foo(this)
+ class(tough_lvl_0(1,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(tough_lvl_1(1,*,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(tough_lvl_2(1,*,*,*)), intent(inout) :: this
+ end subroutine
+
+end module
+
+PROGRAM testprogram
+ USE testmod
+
+ TYPE(tough_lvl_0(1,5)) :: test_pdt_0
+ TYPE(tough_lvl_1(1,5,6)) :: test_pdt_1
+ TYPE(tough_lvl_2(1,5,6,7)) :: test_pdt_2
+
+ CALL test_pdt_0%foo()
+
+ CALL test_pdt_1%foo()
+ CALL test_pdt_1%bar()
+
+ CALL test_pdt_2%foo()
+ CALL test_pdt_2%bar()
+ CALL test_pdt_2%foobar()
+
+
+END PROGRAM testprogram
+
\ No newline at end of file
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 <ctechnodev@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
+
--
2.25.1
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
2024-02-10 23:27 [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268] Alexander Westbrooks
@ 2024-02-11 20:11 ` Harald Anlauf
2024-02-25 20:40 ` Alexander Westbrooks
0 siblings, 1 reply; 7+ messages in thread
From: Harald Anlauf @ 2024-02-11 20:11 UTC (permalink / raw)
To: Alexander Westbrooks, gcc-patches, fortran
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 <ctechnodev@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
> +
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
2024-02-11 20:11 ` Harald Anlauf
@ 2024-02-25 20:40 ` Alexander Westbrooks
2024-02-28 6:24 ` Alexander Westbrooks
0 siblings, 1 reply; 7+ messages in thread
From: Alexander Westbrooks @ 2024-02-25 20:40 UTC (permalink / raw)
To: Harald Anlauf; +Cc: gcc-patches, fortran
[-- Attachment #1.1: Type: text/plain, Size: 6330 bytes --]
Harald,
Thank you for reviewing my code. I've been doing research and debugging to
investigate the error thrown by Intel and NAG for the deferred parameter in
the dummy variable declaration. I found where the problem was and added the
fix as part of my patch. I've attached the patch as a file, which also
includes your feedback and suggested fixes. I've updated the test case
pdt_37.f03 to check for the POINTER or ALLOCATABLE error as you suggested.
All regression tests pass, including the new ones, after including the fix
for the POINTER or ALLOCATABLE error for CLASS declarations of PDTs when
deferred length parameters are used. This was tested on WSL 2, with Ubuntu
20.04 distro.
Is this okay to push to the trunk?
Thanks,
Alexander Westbrooks
On Sun, Feb 11, 2024 at 2:11 PM Harald Anlauf <anlauf@gmx.de> wrote:
> 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 <ctechnodev@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
> > +
>
>
[-- Attachment #2: 0001-Fortran-Error-compiling-PDT-Type-bound-Procedures-PR.patch --]
[-- Type: application/octet-stream, Size: 19313 bytes --]
From bcdde4030f804b8205a9255670e2e9a55395fe82 Mon Sep 17 00:00:00 2001
From: Alexander Westbrooks <alexanderw@gcc.gnu.org>
Date: Sun, 25 Feb 2024 14:28:14 -0600
Subject: [PATCH] Fortran - Error compiling PDT Type-bound Procedures
[PR82943/86148/86268]
This patch allows parameterized derived types to compile successfully
when typebound procedures are specified in the type specification.
Furthermore, it allows function calls for PDTs by setting the
f2k_derived space of PDT instances to reference their original template,
thereby giving it referential access to the typebound procedures of the
template. Lastly, it adds a check for deferred length parameters of
PDTs in CLASS declaration statements, and correctly throws an error if
such declarations are missing POINTER or ALLOCATABLE attributes.
2024-02-25 Alexander Westbrooks <alexanderw@gcc.gnu.org>
gcc/fortran/ChangeLog:
PR fortran/82943
PR fortran/86148
PR fortran/86268
* decl.cc (gfc_get_pdt_instance): Set the PDT instance field
'f2k_derived', if not set already, to point to the given
PDT template 'f2k_derived' namespace in order to give the
PDT instance referential access to the typebound procedures
of the template.
* gfortran.h (gfc_pdt_is_instance_of): Add prototype.
* resolve.cc (resolve_typebound_procedure): If the derived type
does not have the attribute 'pdt_template' set, compare the
dummy argument to the 'resolve_bindings_derived' type like usual.
If the derived type is a 'pdt_template', then check if the
dummy argument is an instance of the PDT template. If the derived
type is a PDT template, and the dummy argument is an instance of
that template, but the dummy argument 'param_list' is not
SPEC_ASSUMED, check if there are any LEN parameters in the
dummy argument. If there are no LEN parameters, then this implies
that there are only KIND parameters in the dummy argument.
If there are LEN parameters, this would be an error, for all
LEN parameters for the dummy argument MUST be assumed for
typebound procedures of PDTs.
(resolve_pdt): Add a check for ALLOCATABLE and POINTER attributes for
SPEC_DEFERRED parameters of PDT class symbols. ALLOCATABLE and
POINTER attributes for a PDT class symbol are stored in the
'class_pointer' and 'allocatable' attributes of the '_data'
component respectively.
* symbol.cc (gfc_pdt_is_instance_of): New function.
gcc/testsuite/ChangeLog:
PR fortran/82943
PR fortran/86148
PR fortran/86268
* gfortran.dg/pdt_4.f03: Update modified error message.
* gfortran.dg/pdt_34.f03: New test.
* gfortran.dg/pdt_35.f03: New test.
* gfortran.dg/pdt_36.f03: New test.
* gfortran.dg/pdt_37.f03: New test.
Signed-off-by: Alexander Westbrooks <alexanderw@gcc.gnu.org>
---
gcc/fortran/decl.cc | 15 ++++++
gcc/fortran/gfortran.h | 1 +
gcc/fortran/resolve.cc | 78 +++++++++++++++++++++++-----
gcc/fortran/symbol.cc | 26 ++++++++++
gcc/testsuite/gfortran.dg/pdt_34.f03 | 42 +++++++++++++++
gcc/testsuite/gfortran.dg/pdt_35.f03 | 45 ++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_36.f03 | 65 +++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_37.f03 | 74 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_4.f03 | 2 +-
9 files changed, 334 insertions(+), 14 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pdt_34.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_35.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_36.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_37.f03
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 503ecb8d9b5..c29b2bb0f45 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4083,6 +4083,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 fd843a3241d..ba46f104f17 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3586,6 +3586,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 44f89f6afb4..4d77289a319 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -14760,14 +14760,64 @@ 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))
+ {
+
+ /* Add a check to verify if there are any LEN parameters in the first place.
+ If there are LEN parameters, throw this error. If there are only KIND
+ parameters, then don't trigger this error. */
+ gfc_component *c;
+ bool seen_len_param = false;
+ gfc_actual_arglist *me_arg_param = me_arg->param_list;
+
+ for (; me_arg_param; me_arg_param = me_arg_param->next)
+ {
+ c = gfc_find_component(
+ CLASS_DATA(me_arg)->ts.u.derived,
+ me_arg_param->name,
+ true, true, NULL);
+
+ gcc_assert (c != NULL);
+ if (c->attr.pdt_kind)
+ continue;
+
+ // Getting here implies that there is a pdt_len parameter in the list.
+ seen_len_param = true;
+ break;
+ }
+
+ if (seen_len_param)
+ {
+ 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)
@@ -15886,11 +15936,13 @@ resolve_pdt (gfc_symbol* sym)
else if (param->spec_type == SPEC_ASSUMED)
assumed_len_exprs = true;
- if (param->spec_type == SPEC_DEFERRED
- && !attr->allocatable && !attr->pointer)
- gfc_error ("The object %qs at %L has a deferred LEN "
- "parameter %qs and is neither allocatable "
- "nor a pointer", sym->name, &sym->declared_at,
+ if (param->spec_type == SPEC_DEFERRED && !attr->allocatable
+ && ( (sym->ts.type == BT_DERIVED && !attr->pointer)
+ || (sym->ts.type == BT_CLASS && !attr->class_pointer)))
+ gfc_error ("Entity %qs at %L has a deferred LEN "
+ "parameter %qs and requires either the POINTER "
+ "or ALLOCATABLE attribute",
+ sym->name, &sym->declared_at,
param->name);
}
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index fddf68f8398..6cfe64fc333 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5172,6 +5172,32 @@ gfc_type_is_extension_of (gfc_symbol *t1, gfc_symbol *t2)
return gfc_compare_derived_types (t1, t2);
}
+/* Check if parameterized derived type t2 is an instance of pdt template t1
+
+ gfc_symbol *t1 -> pdt template to verify t2 against.
+ gfc_symbol *t2 -> pdt instance to be verified.
+
+ 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 kind parameters. To verify if a PDT Type corresponds
+ to the template, this functions extracts t2's derive_type name,
+ and compares it to the derive_type name of t1 for compatibility.
+
+ For example:
+
+ t2->name = Pdtf_2_2; extract out the 'f' and compare with t1->name. */
+bool
+gfc_pdt_is_instance_of(gfc_symbol *t1, gfc_symbol *t2)
+{
+ if ( !t1->attr.pdt_template || !t2->attr.pdt_type )
+ return false;
+
+ /* Limit comparison to length of t1->name to ignore new kind params. */
+ 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.
diff --git a/gcc/testsuite/gfortran.dg/pdt_34.f03 b/gcc/testsuite/gfortran.dg/pdt_34.f03
new file mode 100644
index 00000000000..c601071ba3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_34.f03
@@ -0,0 +1,42 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module m
+ public :: foo, bar, foobar
+
+ type, public :: good_type(n)
+ integer, len :: n = 1
+ contains
+ procedure :: foo
+ end type
+
+ type, public :: good_type2(k)
+ integer, kind :: k = 1
+ contains
+ procedure :: bar
+ end type
+
+ type, public :: good_type3(n, k)
+ integer, len :: n = 1
+ integer, kind :: k = 1
+ contains
+ procedure :: foobar
+ end type
+
+ contains
+ subroutine foo(this)
+ class(good_type(*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(good_type2(2)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(good_type3(*,2)), intent(inout) :: this
+ end subroutine
+
+ end module
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_35.f03 b/gcc/testsuite/gfortran.dg/pdt_35.f03
new file mode 100644
index 00000000000..8b99948fa73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_35.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on inheritance for the type bound procedures.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module m
+
+ public :: foo, bar, foobar
+
+ type, public :: goodpdt_lvl_0(a, b)
+ integer, kind :: a = 1
+ integer, len :: b
+ contains
+ procedure :: foo
+ end type
+
+ type, public, EXTENDS(goodpdt_lvl_0) :: goodpdt_lvl_1 (c)
+ integer, len :: c
+ contains
+ procedure :: bar
+ end type
+
+ type, public, EXTENDS(goodpdt_lvl_1) :: goodpdt_lvl_2 (d)
+ integer, len :: d
+ contains
+ procedure :: foobar
+ end type
+
+contains
+ subroutine foo(this)
+ class(goodpdt_lvl_0(1,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(goodpdt_lvl_1(1,*,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(goodpdt_lvl_2(1,*,*,*)), intent(inout) :: this
+ end subroutine
+
+end module
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_36.f03 b/gcc/testsuite/gfortran.dg/pdt_36.f03
new file mode 100644
index 00000000000..a351c0e4f8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_36.f03
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on calling the type bound procedures in a program.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module testmod
+
+ public :: foo
+
+ type, public :: tough_lvl_0(a, b)
+ integer, kind :: a = 1
+ integer, len :: b
+ contains
+ procedure :: foo
+ end type
+
+ type, public, EXTENDS(tough_lvl_0) :: tough_lvl_1 (c)
+ integer, len :: c
+ contains
+ procedure :: bar
+ end type
+
+ type, public, EXTENDS(tough_lvl_1) :: tough_lvl_2 (d)
+ integer, len :: d
+ contains
+ procedure :: foobar
+ end type
+
+contains
+ subroutine foo(this)
+ class(tough_lvl_0(1,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(tough_lvl_1(1,*,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(tough_lvl_2(1,*,*,*)), intent(inout) :: this
+ end subroutine
+
+end module
+
+PROGRAM testprogram
+ USE testmod
+
+ TYPE(tough_lvl_0(1,5)) :: test_pdt_0
+ TYPE(tough_lvl_1(1,5,6)) :: test_pdt_1
+ TYPE(tough_lvl_2(1,5,6,7)) :: test_pdt_2
+
+ CALL test_pdt_0%foo()
+
+ CALL test_pdt_1%foo()
+ CALL test_pdt_1%bar()
+
+ CALL test_pdt_2%foo()
+ CALL test_pdt_2%bar()
+ CALL test_pdt_2%foobar()
+
+
+END PROGRAM testprogram
+
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_37.f03 b/gcc/testsuite/gfortran.dg/pdt_37.f03
new file mode 100644
index 00000000000..e3a822aa02a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_37.f03
@@ -0,0 +1,74 @@
+! { 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 <ctechnodev@gmail.com>
+!
+module test_len_param
+
+ type :: param_deriv_type(a)
+ integer, len :: a
+ contains
+ procedure :: assumed_len_param ! Good. No error expected.
+ procedure :: assumed_len_param_ptr ! { dg-error "must not be POINTER" }
+ procedure :: assumed_len_param_alloc ! { dg-error "must not be ALLOCATABLE" }
+ procedure :: deferred_len_param ! { dg-error "must be ASSUMED" }
+ procedure :: deferred_len_param_ptr ! { dg-error "must be ASSUMED" }
+ procedure :: deferred_len_param_alloc ! { dg-error "must be ASSUMED" }
+ procedure :: fixed_len_param ! { dg-error "must be ASSUMED" }
+ procedure :: fixed_len_param_ptr ! { dg-error "must be ASSUMED" }
+ procedure :: fixed_len_param_alloc ! { dg-error "must be ASSUMED" }
+
+ end type
+
+contains
+ subroutine assumed_len_param(this)
+ class(param_deriv_type(*)), intent(inout) :: this ! Good. No error expected.
+ ! TYPE(param_deriv_type(*)), intent(inout) :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine assumed_len_param_ptr(this, that)
+ class(param_deriv_type(*)), intent(inout), pointer :: this ! Good. No error expected.
+ ! TYPE(param_deriv_type(*)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine assumed_len_param_alloc(this, that)
+ class(param_deriv_type(*)), intent(inout), allocatable :: this ! Good. No error expected.
+ TYPE(param_deriv_type(*)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine deferred_len_param(this, that) ! { dg-error "requires either the POINTER or ALLOCATABLE attribute" }
+ class(param_deriv_type(:)), intent(inout) :: this
+ TYPE(param_deriv_type(:)), intent(inout) :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine deferred_len_param_ptr(this, that)
+ class(param_deriv_type(:)), intent(inout), pointer :: this ! Good. No error expected.
+ TYPE(param_deriv_type(:)), intent(inout), pointer :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine deferred_len_param_alloc(this, that)
+ class(param_deriv_type(:)), intent(inout), allocatable :: this ! Good. No error expected.
+ TYPE(param_deriv_type(:)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine fixed_len_param(this, that)
+ class(param_deriv_type(10)), intent(inout) :: this ! Good. No error expected.
+ TYPE(param_deriv_type(10)), intent(inout) :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine fixed_len_param_ptr(this, that)
+ class(param_deriv_type(10)), intent(inout), pointer :: this ! Good. No error expected.
+ TYPE(param_deriv_type(10)), intent(inout), pointer :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine fixed_len_param_alloc(this, that)
+ class(param_deriv_type(10)), intent(inout), allocatable :: this ! Good. No error expected.
+ TYPE(param_deriv_type(10)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+end module
+
diff --git a/gcc/testsuite/gfortran.dg/pdt_4.f03 b/gcc/testsuite/gfortran.dg/pdt_4.f03
index 37412e4ca82..f74ac89bf8c 100644
--- a/gcc/testsuite/gfortran.dg/pdt_4.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_4.f03
@@ -96,7 +96,7 @@ contains
subroutine foo(arg)
type (mytype(4, *)) :: arg ! OK
end subroutine
- subroutine bar(arg) ! { dg-error "is neither allocatable nor a pointer" }
+ subroutine bar(arg) ! { dg-error "requires either the POINTER or ALLOCATABLE attribute" }
type (thytype(8, :, 4)) :: arg
end subroutine
subroutine foobar(arg) ! OK
--
2.25.1
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
2024-02-25 20:40 ` Alexander Westbrooks
@ 2024-02-28 6:24 ` Alexander Westbrooks
2024-02-28 19:55 ` Harald Anlauf
0 siblings, 1 reply; 7+ messages in thread
From: Alexander Westbrooks @ 2024-02-28 6:24 UTC (permalink / raw)
To: Harald Anlauf; +Cc: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 6982 bytes --]
Harald,
Jerry helped me figure out my editor settings so that I could fix
whitespace and formatting issues in my code. With my editor configured
correctly, I saw that my code was not conforming to coding standards
as I previously thought it was. I have fixed those things and updated
my patch. Thank you for your patience.
Let me know if this is okay to push to the trunk.
Thanks,
Alexander Westbrooks
On Sun, Feb 25, 2024 at 2:40 PM Alexander Westbrooks
<ctechnodev@gmail.com> wrote:
>
> Harald,
>
> Thank you for reviewing my code. I've been doing research and debugging to investigate the error thrown by Intel and NAG for the deferred parameter in the dummy variable declaration. I found where the problem was and added the fix as part of my patch. I've attached the patch as a file, which also includes your feedback and suggested fixes. I've updated the test case pdt_37.f03 to check for the POINTER or ALLOCATABLE error as you suggested.
>
> All regression tests pass, including the new ones, after including the fix for the POINTER or ALLOCATABLE error for CLASS declarations of PDTs when deferred length parameters are used. This was tested on WSL 2, with Ubuntu 20.04 distro.
>
> Is this okay to push to the trunk?
>
> Thanks,
>
> Alexander Westbrooks
>
>
> On Sun, Feb 11, 2024 at 2:11 PM Harald Anlauf <anlauf@gmx.de> wrote:
>>
>> 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 <ctechnodev@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
>> > +
>>
[-- Attachment #2: 0001-Fortran-Error-compiling-PDT-Type-bound-Procedures-PR-v3.patch --]
[-- Type: application/octet-stream, Size: 19060 bytes --]
From d9a46592606d933d5742f0dec093aadb64682402 Mon Sep 17 00:00:00 2001
From: Alexander Westbrooks <alexanderw@gcc.gnu.org>
Date: Wed, 28 Feb 2024 00:05:35 -0600
Subject: [PATCH] Fortran - Error compiling PDT Type-bound Procedures
[PR82943/86148/86268]
This patch allows parameterized derived types to compile successfully
when typebound procedures are specified in the type specification.
Furthermore, it allows function calls for PDTs by setting the
f2k_derived space of PDT instances to reference their original template,
thereby giving it referential access to the typebound procedures of the
template. Lastly, it adds a check for deferred length parameters of
PDTs in CLASS declaration statements, and correctly throws an error if
such declarations are missing POINTER or ALLOCATABLE attributes.
2024-02-28 Alexander Westbrooks <alexanderw@gcc.gnu.org>
gcc/fortran/ChangeLog:
PR fortran/82943
PR fortran/86148
PR fortran/86268
* decl.cc (gfc_get_pdt_instance): Set the PDT instance field
'f2k_derived', if not set already, to point to the given
PDT template 'f2k_derived' namespace in order to give the
PDT instance referential access to the typebound procedures
of the template.
* gfortran.h (gfc_pdt_is_instance_of): Add prototype.
* resolve.cc (resolve_typebound_procedure): If the derived type
does not have the attribute 'pdt_template' set, compare the
dummy argument to the 'resolve_bindings_derived' type like usual.
If the derived type is a 'pdt_template', then check if the
dummy argument is an instance of the PDT template. If the derived
type is a PDT template, and the dummy argument is an instance of
that template, but the dummy argument 'param_list' is not
SPEC_ASSUMED, check if there are any LEN parameters in the
dummy argument. If there are no LEN parameters, then this implies
that there are only KIND parameters in the dummy argument.
If there are LEN parameters, this would be an error, for all
LEN parameters for the dummy argument MUST be assumed for
typebound procedures of PDTs.
(resolve_pdt): Add a check for ALLOCATABLE and POINTER attributes for
SPEC_DEFERRED parameters of PDT class symbols. ALLOCATABLE and
POINTER attributes for a PDT class symbol are stored in the
'class_pointer' and 'allocatable' attributes of the '_data'
component respectively.
* symbol.cc (gfc_pdt_is_instance_of): New function.
gcc/testsuite/ChangeLog:
PR fortran/82943
PR fortran/86148
PR fortran/86268
* gfortran.dg/pdt_4.f03: Update modified error message.
* gfortran.dg/pdt_34.f03: New test.
* gfortran.dg/pdt_35.f03: New test.
* gfortran.dg/pdt_36.f03: New test.
* gfortran.dg/pdt_37.f03: New test.
Signed-off-by: Alexander Westbrooks <alexanderw@gcc.gnu.org>
---
gcc/fortran/decl.cc | 15 ++++++
gcc/fortran/gfortran.h | 1 +
gcc/fortran/resolve.cc | 74 ++++++++++++++++++++++++----
gcc/fortran/symbol.cc | 27 ++++++++++
gcc/testsuite/gfortran.dg/pdt_34.f03 | 42 ++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_35.f03 | 45 +++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_36.f03 | 65 ++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_37.f03 | 74 ++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pdt_4.f03 | 2 +-
9 files changed, 335 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pdt_34.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_35.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_36.f03
create mode 100644 gcc/testsuite/gfortran.dg/pdt_37.f03
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 503ecb8d9b5..a7576f4bc40 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4083,6 +4083,21 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
continue;
}
+ /* Addressing PR82943, this will fix the issue where a function or
+ 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 fd843a3241d..ebba2336e12 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3586,6 +3586,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 44f89f6afb4..852e0820e6a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -14760,15 +14760,69 @@ resolve_typebound_procedure (gfc_symtree* stree)
goto error;
}
- if (CLASS_DATA (me_arg)->ts.u.derived
- != resolve_bindings_derived)
+ /* 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,
+ 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))
+ {
+
+ /* Add a check to verify if there are any LEN parameters in the
+ first place. If there are LEN parameters, throw this error.
+ If there are only KIND parameters, then don't trigger
+ this error. */
+ gfc_component *c;
+ bool seen_len_param = false;
+ gfc_actual_arglist *me_arg_param = me_arg->param_list;
+
+ for (; me_arg_param; me_arg_param = me_arg_param->next)
+ {
+ c = gfc_find_component (CLASS_DATA(me_arg)->ts.u.derived,
+ me_arg_param->name, true, true, NULL);
+
+ gcc_assert (c != NULL);
+
+ if (c->attr.pdt_kind)
+ continue;
+
+ /* Getting here implies that there is a pdt_len parameter
+ in the list. */
+ seen_len_param = true;
+ break;
+ }
+
+ if (seen_len_param)
+ {
+ 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)
{
@@ -15886,11 +15940,13 @@ resolve_pdt (gfc_symbol* sym)
else if (param->spec_type == SPEC_ASSUMED)
assumed_len_exprs = true;
- if (param->spec_type == SPEC_DEFERRED
- && !attr->allocatable && !attr->pointer)
- gfc_error ("The object %qs at %L has a deferred LEN "
- "parameter %qs and is neither allocatable "
- "nor a pointer", sym->name, &sym->declared_at,
+ if (param->spec_type == SPEC_DEFERRED && !attr->allocatable
+ && ((sym->ts.type == BT_DERIVED && !attr->pointer)
+ || (sym->ts.type == BT_CLASS && !attr->class_pointer)))
+ gfc_error ("Entity %qs at %L has a deferred LEN "
+ "parameter %qs and requires either the POINTER "
+ "or ALLOCATABLE attribute",
+ sym->name, &sym->declared_at,
param->name);
}
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index fddf68f8398..5d9852c79e0 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5172,6 +5172,33 @@ gfc_type_is_extension_of (gfc_symbol *t1, gfc_symbol *t2)
return gfc_compare_derived_types (t1, t2);
}
+/* Check if parameterized derived type t2 is an instance of pdt template t1
+
+ gfc_symbol *t1 -> pdt template to verify t2 against.
+ gfc_symbol *t2 -> pdt instance to be verified.
+
+ 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 kind parameters. To verify if a PDT Type corresponds
+ to the template, this functions extracts t2's derive_type name,
+ and compares it to the derive_type name of t1 for compatibility.
+
+ For example:
+
+ t2->name = Pdtf_2_2; extract out the 'f' and compare with t1->name. */
+
+bool
+gfc_pdt_is_instance_of (gfc_symbol *t1, gfc_symbol *t2)
+{
+ if ( !t1->attr.pdt_template || !t2->attr.pdt_type )
+ return false;
+
+ /* Limit comparison to length of t1->name to ignore new kind params. */
+ 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.
diff --git a/gcc/testsuite/gfortran.dg/pdt_34.f03 b/gcc/testsuite/gfortran.dg/pdt_34.f03
new file mode 100644
index 00000000000..c601071ba3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_34.f03
@@ -0,0 +1,42 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module m
+ public :: foo, bar, foobar
+
+ type, public :: good_type(n)
+ integer, len :: n = 1
+ contains
+ procedure :: foo
+ end type
+
+ type, public :: good_type2(k)
+ integer, kind :: k = 1
+ contains
+ procedure :: bar
+ end type
+
+ type, public :: good_type3(n, k)
+ integer, len :: n = 1
+ integer, kind :: k = 1
+ contains
+ procedure :: foobar
+ end type
+
+ contains
+ subroutine foo(this)
+ class(good_type(*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(good_type2(2)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(good_type3(*,2)), intent(inout) :: this
+ end subroutine
+
+ end module
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_35.f03 b/gcc/testsuite/gfortran.dg/pdt_35.f03
new file mode 100644
index 00000000000..8b99948fa73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_35.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on inheritance for the type bound procedures.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module m
+
+ public :: foo, bar, foobar
+
+ type, public :: goodpdt_lvl_0(a, b)
+ integer, kind :: a = 1
+ integer, len :: b
+ contains
+ procedure :: foo
+ end type
+
+ type, public, EXTENDS(goodpdt_lvl_0) :: goodpdt_lvl_1 (c)
+ integer, len :: c
+ contains
+ procedure :: bar
+ end type
+
+ type, public, EXTENDS(goodpdt_lvl_1) :: goodpdt_lvl_2 (d)
+ integer, len :: d
+ contains
+ procedure :: foobar
+ end type
+
+contains
+ subroutine foo(this)
+ class(goodpdt_lvl_0(1,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(goodpdt_lvl_1(1,*,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(goodpdt_lvl_2(1,*,*,*)), intent(inout) :: this
+ end subroutine
+
+end module
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_36.f03 b/gcc/testsuite/gfortran.dg/pdt_36.f03
new file mode 100644
index 00000000000..a351c0e4f8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_36.f03
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! Tests the fixes for PR82943.
+!
+! This test focuses on calling the type bound procedures in a program.
+!
+! Contributed by Alexander Westbrooks <ctechnodev@gmail.com>
+!
+module testmod
+
+ public :: foo
+
+ type, public :: tough_lvl_0(a, b)
+ integer, kind :: a = 1
+ integer, len :: b
+ contains
+ procedure :: foo
+ end type
+
+ type, public, EXTENDS(tough_lvl_0) :: tough_lvl_1 (c)
+ integer, len :: c
+ contains
+ procedure :: bar
+ end type
+
+ type, public, EXTENDS(tough_lvl_1) :: tough_lvl_2 (d)
+ integer, len :: d
+ contains
+ procedure :: foobar
+ end type
+
+contains
+ subroutine foo(this)
+ class(tough_lvl_0(1,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine bar(this)
+ class(tough_lvl_1(1,*,*)), intent(inout) :: this
+ end subroutine
+
+ subroutine foobar(this)
+ class(tough_lvl_2(1,*,*,*)), intent(inout) :: this
+ end subroutine
+
+end module
+
+PROGRAM testprogram
+ USE testmod
+
+ TYPE(tough_lvl_0(1,5)) :: test_pdt_0
+ TYPE(tough_lvl_1(1,5,6)) :: test_pdt_1
+ TYPE(tough_lvl_2(1,5,6,7)) :: test_pdt_2
+
+ CALL test_pdt_0%foo()
+
+ CALL test_pdt_1%foo()
+ CALL test_pdt_1%bar()
+
+ CALL test_pdt_2%foo()
+ CALL test_pdt_2%bar()
+ CALL test_pdt_2%foobar()
+
+
+END PROGRAM testprogram
+
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pdt_37.f03 b/gcc/testsuite/gfortran.dg/pdt_37.f03
new file mode 100644
index 00000000000..e3a822aa02a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_37.f03
@@ -0,0 +1,74 @@
+! { 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 <ctechnodev@gmail.com>
+!
+module test_len_param
+
+ type :: param_deriv_type(a)
+ integer, len :: a
+ contains
+ procedure :: assumed_len_param ! Good. No error expected.
+ procedure :: assumed_len_param_ptr ! { dg-error "must not be POINTER" }
+ procedure :: assumed_len_param_alloc ! { dg-error "must not be ALLOCATABLE" }
+ procedure :: deferred_len_param ! { dg-error "must be ASSUMED" }
+ procedure :: deferred_len_param_ptr ! { dg-error "must be ASSUMED" }
+ procedure :: deferred_len_param_alloc ! { dg-error "must be ASSUMED" }
+ procedure :: fixed_len_param ! { dg-error "must be ASSUMED" }
+ procedure :: fixed_len_param_ptr ! { dg-error "must be ASSUMED" }
+ procedure :: fixed_len_param_alloc ! { dg-error "must be ASSUMED" }
+
+ end type
+
+contains
+ subroutine assumed_len_param(this)
+ class(param_deriv_type(*)), intent(inout) :: this ! Good. No error expected.
+ ! TYPE(param_deriv_type(*)), intent(inout) :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine assumed_len_param_ptr(this, that)
+ class(param_deriv_type(*)), intent(inout), pointer :: this ! Good. No error expected.
+ ! TYPE(param_deriv_type(*)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine assumed_len_param_alloc(this, that)
+ class(param_deriv_type(*)), intent(inout), allocatable :: this ! Good. No error expected.
+ TYPE(param_deriv_type(*)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine deferred_len_param(this, that) ! { dg-error "requires either the POINTER or ALLOCATABLE attribute" }
+ class(param_deriv_type(:)), intent(inout) :: this
+ TYPE(param_deriv_type(:)), intent(inout) :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine deferred_len_param_ptr(this, that)
+ class(param_deriv_type(:)), intent(inout), pointer :: this ! Good. No error expected.
+ TYPE(param_deriv_type(:)), intent(inout), pointer :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine deferred_len_param_alloc(this, that)
+ class(param_deriv_type(:)), intent(inout), allocatable :: this ! Good. No error expected.
+ TYPE(param_deriv_type(:)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine fixed_len_param(this, that)
+ class(param_deriv_type(10)), intent(inout) :: this ! Good. No error expected.
+ TYPE(param_deriv_type(10)), intent(inout) :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine fixed_len_param_ptr(this, that)
+ class(param_deriv_type(10)), intent(inout), pointer :: this ! Good. No error expected.
+ TYPE(param_deriv_type(10)), intent(inout), pointer :: that ! Good. No error expected.
+ end subroutine
+
+ subroutine fixed_len_param_alloc(this, that)
+ class(param_deriv_type(10)), intent(inout), allocatable :: this ! Good. No error expected.
+ TYPE(param_deriv_type(10)), intent(inout), allocatable :: that ! Good. No error expected.
+ end subroutine
+
+end module
+
diff --git a/gcc/testsuite/gfortran.dg/pdt_4.f03 b/gcc/testsuite/gfortran.dg/pdt_4.f03
index 37412e4ca82..f74ac89bf8c 100644
--- a/gcc/testsuite/gfortran.dg/pdt_4.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_4.f03
@@ -96,7 +96,7 @@ contains
subroutine foo(arg)
type (mytype(4, *)) :: arg ! OK
end subroutine
- subroutine bar(arg) ! { dg-error "is neither allocatable nor a pointer" }
+ subroutine bar(arg) ! { dg-error "requires either the POINTER or ALLOCATABLE attribute" }
type (thytype(8, :, 4)) :: arg
end subroutine
subroutine foobar(arg) ! OK
--
2.25.1
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
2024-02-28 6:24 ` Alexander Westbrooks
@ 2024-02-28 19:55 ` Harald Anlauf
2024-02-29 2:24 ` Alexander Westbrooks
0 siblings, 1 reply; 7+ messages in thread
From: Harald Anlauf @ 2024-02-28 19:55 UTC (permalink / raw)
To: Alexander Westbrooks; +Cc: gcc-patches, fortran
Hi Alex,
this is now mostly correct, with the following exceptions:
First, you should notice that the formatting of the commit message,
when checked using "git gcc-verify", needs minor corrections. You
will be guided how to fix this yourself.
Second, testcase pdt_37.f03 has an undeclared dummy argument, which
can be detected by adding "implicit none" (I usually use that
whenever implicit typing is not wanted explicitly). I would get:
pdt_37.f03:33:47:
33 | subroutine assumed_len_param_ptr(this, that)
| 1
Error: Symbol 'that' at (1) has no IMPLICIT type; did you mean 'this'?
I assume you want to uncomment the declaration of dummy 'that'.
Third, I still see a - minor - indentation/tabbing/space issue here:
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 44f89f6afb4..852e0820e6a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
[...]
+ 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))
OK with the above fixed.
Thanks for the patch!
Harald
On 2/28/24 07:24, Alexander Westbrooks wrote:
> Harald,
>
> Jerry helped me figure out my editor settings so that I could fix
> whitespace and formatting issues in my code. With my editor configured
> correctly, I saw that my code was not conforming to coding standards
> as I previously thought it was. I have fixed those things and updated
> my patch. Thank you for your patience.
>
> Let me know if this is okay to push to the trunk.
>
> Thanks,
>
> Alexander Westbrooks
>
> On Sun, Feb 25, 2024 at 2:40 PM Alexander Westbrooks
> <ctechnodev@gmail.com> wrote:
>>
>> Harald,
>>
>> Thank you for reviewing my code. I've been doing research and debugging to investigate the error thrown by Intel and NAG for the deferred parameter in the dummy variable declaration. I found where the problem was and added the fix as part of my patch. I've attached the patch as a file, which also includes your feedback and suggested fixes. I've updated the test case pdt_37.f03 to check for the POINTER or ALLOCATABLE error as you suggested.
>>
>> All regression tests pass, including the new ones, after including the fix for the POINTER or ALLOCATABLE error for CLASS declarations of PDTs when deferred length parameters are used. This was tested on WSL 2, with Ubuntu 20.04 distro.
>>
>> Is this okay to push to the trunk?
>>
>> Thanks,
>>
>> Alexander Westbrooks
>>
>>
>> On Sun, Feb 11, 2024 at 2:11 PM Harald Anlauf <anlauf@gmx.de> wrote:
>>>
>>> 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 <ctechnodev@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
>>>> +
>>>
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
2024-02-28 19:55 ` Harald Anlauf
@ 2024-02-29 2:24 ` Alexander Westbrooks
2024-02-29 2:48 ` Alexander Westbrooks
0 siblings, 1 reply; 7+ messages in thread
From: Alexander Westbrooks @ 2024-02-29 2:24 UTC (permalink / raw)
To: Harald Anlauf; +Cc: gcc-patches, fortran
Hello,
I've updated the patch with those changes, ran through the gcc-verify
step and fixed up the commit, and then pushed it to the trunk.
Thank you for your feedback, and I look forward to working on GFortran.
Thanks,
Alexander Westbrooks
On Wed, Feb 28, 2024 at 1:55 PM Harald Anlauf <anlauf@gmx.de> wrote:
>
> Hi Alex,
>
> this is now mostly correct, with the following exceptions:
>
> First, you should notice that the formatting of the commit message,
> when checked using "git gcc-verify", needs minor corrections. You
> will be guided how to fix this yourself.
>
> Second, testcase pdt_37.f03 has an undeclared dummy argument, which
> can be detected by adding "implicit none" (I usually use that
> whenever implicit typing is not wanted explicitly). I would get:
>
> pdt_37.f03:33:47:
>
> 33 | subroutine assumed_len_param_ptr(this, that)
> | 1
> Error: Symbol 'that' at (1) has no IMPLICIT type; did you mean 'this'?
>
> I assume you want to uncomment the declaration of dummy 'that'.
>
> Third, I still see a - minor - indentation/tabbing/space issue here:
>
> diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
> index 44f89f6afb4..852e0820e6a 100644
> --- a/gcc/fortran/resolve.cc
> +++ b/gcc/fortran/resolve.cc
> [...]
> + 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))
>
> OK with the above fixed.
>
> Thanks for the patch!
>
> Harald
>
> On 2/28/24 07:24, Alexander Westbrooks wrote:
> > Harald,
> >
> > Jerry helped me figure out my editor settings so that I could fix
> > whitespace and formatting issues in my code. With my editor configured
> > correctly, I saw that my code was not conforming to coding standards
> > as I previously thought it was. I have fixed those things and updated
> > my patch. Thank you for your patience.
> >
> > Let me know if this is okay to push to the trunk.
> >
> > Thanks,
> >
> > Alexander Westbrooks
> >
> > On Sun, Feb 25, 2024 at 2:40 PM Alexander Westbrooks
> > <ctechnodev@gmail.com> wrote:
> >>
> >> Harald,
> >>
> >> Thank you for reviewing my code. I've been doing research and debugging to investigate the error thrown by Intel and NAG for the deferred parameter in the dummy variable declaration. I found where the problem was and added the fix as part of my patch. I've attached the patch as a file, which also includes your feedback and suggested fixes. I've updated the test case pdt_37.f03 to check for the POINTER or ALLOCATABLE error as you suggested.
> >>
> >> All regression tests pass, including the new ones, after including the fix for the POINTER or ALLOCATABLE error for CLASS declarations of PDTs when deferred length parameters are used. This was tested on WSL 2, with Ubuntu 20.04 distro.
> >>
> >> Is this okay to push to the trunk?
> >>
> >> Thanks,
> >>
> >> Alexander Westbrooks
> >>
> >>
> >> On Sun, Feb 11, 2024 at 2:11 PM Harald Anlauf <anlauf@gmx.de> wrote:
> >>>
> >>> 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 <ctechnodev@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
> >>>> +
> >>>
>
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268]
2024-02-29 2:24 ` Alexander Westbrooks
@ 2024-02-29 2:48 ` Alexander Westbrooks
0 siblings, 0 replies; 7+ messages in thread
From: Alexander Westbrooks @ 2024-02-29 2:48 UTC (permalink / raw)
To: Harald Anlauf; +Cc: gcc-patches, fortran
Hello,
I meant to add a link to the commit to the previous email:
https://gcc.gnu.org/git/gitweb.cgi?p=gcc.git;h=edfe198084338691d0facc86bf8dfa6ede3ca676
Thanks,
Alexander Westbrooks
On Wed, Feb 28, 2024 at 8:24 PM Alexander Westbrooks
<ctechnodev@gmail.com> wrote:
>
> Hello,
>
> I've updated the patch with those changes, ran through the gcc-verify
> step and fixed up the commit, and then pushed it to the trunk.
>
> Thank you for your feedback, and I look forward to working on GFortran.
>
> Thanks,
>
> Alexander Westbrooks
>
> On Wed, Feb 28, 2024 at 1:55 PM Harald Anlauf <anlauf@gmx.de> wrote:
> >
> > Hi Alex,
> >
> > this is now mostly correct, with the following exceptions:
> >
> > First, you should notice that the formatting of the commit message,
> > when checked using "git gcc-verify", needs minor corrections. You
> > will be guided how to fix this yourself.
> >
> > Second, testcase pdt_37.f03 has an undeclared dummy argument, which
> > can be detected by adding "implicit none" (I usually use that
> > whenever implicit typing is not wanted explicitly). I would get:
> >
> > pdt_37.f03:33:47:
> >
> > 33 | subroutine assumed_len_param_ptr(this, that)
> > | 1
> > Error: Symbol 'that' at (1) has no IMPLICIT type; did you mean 'this'?
> >
> > I assume you want to uncomment the declaration of dummy 'that'.
> >
> > Third, I still see a - minor - indentation/tabbing/space issue here:
> >
> > diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
> > index 44f89f6afb4..852e0820e6a 100644
> > --- a/gcc/fortran/resolve.cc
> > +++ b/gcc/fortran/resolve.cc
> > [...]
> > + 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))
> >
> > OK with the above fixed.
> >
> > Thanks for the patch!
> >
> > Harald
> >
> > On 2/28/24 07:24, Alexander Westbrooks wrote:
> > > Harald,
> > >
> > > Jerry helped me figure out my editor settings so that I could fix
> > > whitespace and formatting issues in my code. With my editor configured
> > > correctly, I saw that my code was not conforming to coding standards
> > > as I previously thought it was. I have fixed those things and updated
> > > my patch. Thank you for your patience.
> > >
> > > Let me know if this is okay to push to the trunk.
> > >
> > > Thanks,
> > >
> > > Alexander Westbrooks
> > >
> > > On Sun, Feb 25, 2024 at 2:40 PM Alexander Westbrooks
> > > <ctechnodev@gmail.com> wrote:
> > >>
> > >> Harald,
> > >>
> > >> Thank you for reviewing my code. I've been doing research and debugging to investigate the error thrown by Intel and NAG for the deferred parameter in the dummy variable declaration. I found where the problem was and added the fix as part of my patch. I've attached the patch as a file, which also includes your feedback and suggested fixes. I've updated the test case pdt_37.f03 to check for the POINTER or ALLOCATABLE error as you suggested.
> > >>
> > >> All regression tests pass, including the new ones, after including the fix for the POINTER or ALLOCATABLE error for CLASS declarations of PDTs when deferred length parameters are used. This was tested on WSL 2, with Ubuntu 20.04 distro.
> > >>
> > >> Is this okay to push to the trunk?
> > >>
> > >> Thanks,
> > >>
> > >> Alexander Westbrooks
> > >>
> > >>
> > >> On Sun, Feb 11, 2024 at 2:11 PM Harald Anlauf <anlauf@gmx.de> wrote:
> > >>>
> > >>> 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 <ctechnodev@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
> > >>>> +
> > >>>
> >
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2024-02-29 2:49 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-02-10 23:27 [PATCH] Fortran - Error compiling PDT Type-bound Procedures [PR82943/86148/86268] Alexander Westbrooks
2024-02-11 20:11 ` Harald Anlauf
2024-02-25 20:40 ` Alexander Westbrooks
2024-02-28 6:24 ` Alexander Westbrooks
2024-02-28 19:55 ` Harald Anlauf
2024-02-29 2:24 ` Alexander Westbrooks
2024-02-29 2:48 ` Alexander Westbrooks
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).