Hi All, I don't think that this PR is really a regression although the fact that it is marked as such brought it to my attention :-)
The fix turned out to be remarkably simple. It was found after going down a silly number of rabbit holes, though! The chunk in dependency.cc is probably more elaborate than it needs to be. Returning -2 is sufficient for the testcase to work. Otherwise, the comments in the patch say it all. OK for mainline? I will delay for a month before backporting. Regards Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index fb4d94de641..bafe8cbc5bc 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -440,6 +440,38 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
return mpz_sgn (e2->value.op.op2->value.integer);
}
+
+ if (e1->expr_type == EXPR_COMPCALL)
+ {
+ /* This will have emerged from interface.cc(gfc_check_typebound_override)
+ via gfc_check_result_characteristics. It is possible that other
+ variants exist that are 'equal' but play it safe for now by setting
+ the relationship as 'indeterminate'. */
+ if (e2->expr_type == EXPR_FUNCTION && e2->ref)
+ {
+ gfc_ref *ref = e2->ref;
+ gfc_symbol *s = NULL;
+
+ if (e1->value.compcall.tbp->u.specific)
+ s = e1->value.compcall.tbp->u.specific->n.sym;
+
+ /* Check if the proc ptr points to an interface declaration and the
+ names are the same; ie. the overriden proc. of an abstract type.
+ The checking of the arguments will already have been done. */
+ for (; ref && s; ref = ref->next)
+ if (!ref->next && ref->type == REF_COMPONENT
+ && ref->u.c.component->attr.proc_pointer
+ && ref->u.c.component->ts.interface
+ && ref->u.c.component->ts.interface->attr.if_source
+ == IFSRC_IFBODY
+ && !strcmp (s->name, ref->u.c.component->name))
+ return 0;
+ }
+
+ /* Assume as default that TKR checking is sufficient. */
+ return -2;
+ }
+
if (e1->expr_type != e2->expr_type)
return -3;
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index c883966646c..4ee2ad55915 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3210,6 +3210,11 @@ gfc_reduce_init_expr (gfc_expr *expr)
{
bool t;
+ /* It is far too early to resolve a class compcall. Punt to resolution. */
+ if (expr && expr->expr_type == EXPR_COMPCALL
+ && expr->symtree->n.sym->ts.type == BT_CLASS)
+ return true;
+
gfc_init_expr_flag = true;
t = gfc_resolve_expr (expr);
if (t)
diff --git a/gcc/testsuite/gfortran.dg/pr103312.f90 b/gcc/testsuite/gfortran.dg/pr103312.f90
new file mode 100644
index 00000000000..deacc70bf5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103312.f90
@@ -0,0 +1,87 @@
+! { dg-do run }
+!
+! Test the fix for pr103312, in which the use of a component call in
+! initialization expressions, eg. character(this%size()), caused ICEs.
+!
+! Contributed by Arseny Solokha <asolo...@gmx.com>
+!
+module example
+
+ type, abstract :: foo
+ integer :: i
+ contains
+ procedure(foo_size), deferred :: size
+ procedure(foo_func), deferred :: func
+ end type
+
+ interface
+ function foo_func (this) result (string)
+ import :: foo
+ class(foo) :: this
+ character(this%size()) :: string
+ end function
+ pure integer function foo_size (this)
+ import foo
+ class(foo), intent(in) :: this
+ end function
+ end interface
+
+end module
+
+module extension
+ use example
+ implicit none
+ type, extends(foo) :: bar
+ contains
+ procedure :: size
+ procedure :: func
+ end type
+
+contains
+ pure integer function size (this)
+ class(bar), intent(in) :: this
+ size = this%i
+ end function
+ function func (this) result (string)
+ class(bar) :: this
+ character(this%size()) :: string
+ string = repeat ("x", len (string))
+ end function
+
+end module
+
+module unextended
+ implicit none
+ type :: foobar
+ integer :: i
+ contains
+ procedure :: size
+ procedure :: func
+ end type
+
+contains
+ pure integer function size (this)
+ class(foobar), intent(in) :: this
+ size = this%i
+ end function
+ function func (this) result (string)
+ class(foobar) :: this
+ character(this%size()) :: string
+ character(:), allocatable :: chr
+ string = repeat ("y", len (string))
+ allocate (character(this%size()) :: chr)
+ if (len (string) .ne. len (chr)) stop 1
+ end function
+
+end module
+
+ use example
+ use extension
+ use unextended
+ type(bar) :: a
+ type(foobar) :: b
+ a%i = 5
+ if (a%func() .ne. 'xxxxx') stop 2
+ b%i = 7
+ if (b%func() .ne. 'yyyyyyy') stop 3
+end
