[Bug fortran/109684] compiling failure: complaining about a final subroutine of a type being not PURE (while it is indeed PURE)

["sgk at troutmask dot apl.washington.edu" <gcc-bugzilla@gcc.gnu.org>]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109684

--- Comment #23 from Steve Kargl <sgk at troutmask dot apl.washington.edu> ---
On Wed, Aug 09, 2023 at 04:19:52PM +0000, trnka at scm dot com wrote:
> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109684
> 
> --- Comment #22 from Tomáš Trnka <trnka at scm dot com> ---
> (In reply to Steve Kargl from comment #21)
> > I missed your comment #7 as simply grabbed the "slightly
> > more simplified" attachment and started a bug hunt from there.
> > Do either of the other testcase attachments exhibit the issue?
> 
> Unfortunately, none of the testcases attached to this bug happen to trigger
> that particular issue. It seems to pop up in many different modules in our
> codebase, but they are all modules with quite complicated dependency trees, so
> isolating a small testcase from them is not straigtforward (I need to start
> from several tens of thousands of SLOC worth of stuff and manually try to
> reduce it from there, which is tedious at best).
> 
> That's why I was hoping one of you GCC devs might have an idea of what could
> possibly be wrong (and some suggestions on what to look at in the gfortran
> internals or which pieces of code to start playing with).
> 
> The bad part is that what should just be a warning ends up bringing the
> compiler down because it hits an assert in the diagnostic printing code. Does
> expr->where being completely blank sound suspicious? Perhaps something to do
> with the artificially generated code?

If expr->where is pointing to NULL, then something is definitely not
set up correctly or your code is now going through a different code
path in the compiler.  Normally, if the locus can be NULL, one has
something like

   if (!expr->where)
      gcc_error ("Use last known locus --> %C");
   else
      gcc_error ("Use expr->where locus--> %L", &expr->where);

You're clearly not getting this.

If this is related to setting up the artificial __final_* procedure,
then it might be missing properly setting the locus.  This patch
simply sets the locus of the artificial procedure and its arguments
to that of the derived symbol.  This might prevent the ICE, but
lead to a bogus error message.  Can you test this?

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 9d0c802b867..ee591793c19 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -1739,6 +1739,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
   name = xasprintf ("__final_%s", tname);
   gfc_get_symbol (name, sub_ns, &final);
   sub_ns->proc_name = final;
+  final->declared_at = derived->declared_at;
   final->attr.flavor = FL_PROCEDURE;
   final->attr.function = 1;
   final->attr.pure = 0;
@@ -1756,6 +1757,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,

   /* Set up formal argument.  */
   gfc_get_symbol ("array", sub_ns, &array);
+  array->declared_at = derived->declared_at;
   array->ts.type = BT_DERIVED;
   array->ts.u.derived = derived;
   array->attr.flavor = FL_VARIABLE;
@@ -1774,6 +1776,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,

   /* Set up formal argument.  */
   gfc_get_symbol ("byte_stride", sub_ns, &byte_stride);
+  byte_stride->declared_at = derived->declared_at;
   byte_stride->ts.type = BT_INTEGER;
   byte_stride->ts.kind = gfc_index_integer_kind;
   byte_stride->attr.flavor = FL_VARIABLE;
@@ -1787,6 +1790,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,

   /* Set up formal argument.  */
   gfc_get_symbol ("fini_coarray", sub_ns, &fini_coarray);
+  fini_coarray->declared_at = derived->declared_at;
   fini_coarray->ts.type = BT_LOGICAL;
   fini_coarray->ts.kind = 1;
   fini_coarray->attr.flavor = FL_VARIABLE;