[Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e

[Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e

[Paul Richard Thomas]

[-- Attachment #1.1: Type: text/plain, Size: 505 bytes --]

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

[-- Attachment #2: Change.Logs --]
[-- Type: application/octet-stream, Size: 551 bytes --]

Fortran: Fix ICEs due to comp calls in initialization exprs [PR103312]

2024-04-02  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/103312
	* dependency.cc (gfc_dep_compare_expr): Handle component call
	expressions. Return -2 as default and return 0 if compared with
	a function expression that is from an interface body and has
	the same name.
	* expr.cc (gfc_reduce_init_expr): If the expression is a comp
	call do not attempt to reduce and defer until resolution.

gcc/testsuite/
	PR fortran/103312
	* gfortran.dg/pr103312.f90: New test.

[-- Attachment #3: submit.diff --]
[-- Type: text/x-patch, Size: 4184 bytes --]

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  <asolokha@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

Re: [Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e

[Harald Anlauf]

Hi Paul,

Am 20.05.24 um 11:06 schrieb Paul Richard Thomas:
> 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.

this part looks OK, but can you elaborate on this change to expr.cc:

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;
+

I would have expected to return 'false' here, as we do not
have an expression that reduces to a constant.  What am I
missing?

(The testcase compiles and works here also when using 'false'.)

> OK for mainline? I will delay for a month before backporting.

OK if can you show me wrong...

Thanks,
Harald

> Regards
>
> Paul
>

Re: [Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 1678 bytes --]

Hi Harald,

You were absolutely right about returning 'false' :-) The patch is duly
corrected.

Committed to mainline and will be followed by backports in a few weeks.

Regards

Paul


On Tue, 21 May 2024 at 19:58, Harald Anlauf <anlauf@gmx.de> wrote:

> Hi Paul,
>
> Am 20.05.24 um 11:06 schrieb Paul Richard Thomas:
> > 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.
>
> this part looks OK, but can you elaborate on this change to expr.cc:
>
> 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;
> +
>
> I would have expected to return 'false' here, as we do not
> have an expression that reduces to a constant.  What am I
> missing?
>
> (The testcase compiles and works here also when using 'false'.)
>
> > OK for mainline? I will delay for a month before backporting.
>
> OK if can you show me wrong...
>
> Thanks,
> Harald
>
> > Regards
> >
> > Paul
> >
>
>