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