Re: [Patch, fortran] PR59104

2024-06-14 Thread Harald Anlauf

Hi Paul,

this looks good to me and is OK for mainline.  When it has survived a
week or two, backporting at least to 14-branch (ideally before 14.2
release) would be a good thing!

Regarding the following excerpt of the testcase:

+! Commented out lines give implicit type warnings with gfortran and nagfor
+!character(len = len (d)) :: line4 (len (line3))
+character(len = len (line3)) :: line4 (len (line3))
+!character(len = size(len4, 1)) :: line5

I guess the last commented line should have referred to size(line4, 1),
right?  The lexical distance of len4 and line4 can be small after
long coding...

The first commented line gives no warning here, but is simply
inconsistent with a test later on, since len (d) < len (line3).
What exactly was the issue?

***

A minor nit: while you were fixing whitespace issues in the source,
you missed an indent with spaces here:

@@ -857,12 +873,26 @@ gfc_defer_symbol_init (gfc_symbol * sym)
   /* Find the first dummy arg seen after us, or the first
non-dummy arg.
  This is a circular list, so don't go past the head.  */
   while (p != head
- && (!p->attr.dummy || p->dummy_order > sym->dummy_order))
+ && (!p->attr.dummy || decl_order (p, sym)))
 {

At least on my side there is no tab...
(It is fine in a similar code later on.)

***

Finally a big thanks for the patch!

Harald


Am 13.06.24 um 23:43 schrieb Paul Richard Thomas:

Hi Both,

Thanks for the highly constructive comments. I think that I have
incorporated them fully in the attached.

OK for mainline and ...?

Paul


On Mon, 10 Jun 2024 at 08:19, Andre Vehreschild  wrote:


Hi Paul,

while looking at your patch I see calls to gfc_add_init_cleanup (...,
back),
while the function signature is gfc_add_init_cleanup (..., bool front).
This
slightly confuses me. I would at least expect to see
gfc_add_init_cleanup(...,
!back) calls. Just to get the semantics right.

Then I wonder why not doing:

diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index bafe8cbc5bc..97ace8c778e 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr
*rexpr)
return true;
  }
+
+
+/* gfc_function_dependency returns true for non-dummy symbols with
dependencies
+   on an old-fashioned function result (ie. proc_name =
proc_name->result).
+   This is used to ensure that initialization code appears after the
function
+   result is treated and that any mutual dependencies between these
symbols are
+   respected.  */
+
+static bool
+dependency_fcn (gfc_expr *e, gfc_symbol *sym,
+int *f ATTRIBUTE_UNUSED)
+{
+  return (e && e->expr_type == EXPR_VARIABLE
+  && e->symtree
+  && e->symtree->n.sym == sym);
+}

Instead of the multiple if-statements?

+
+bool
+gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
+{
+  bool front = false;
+
+  if (proc_name && proc_name->attr.function
+  && proc_name == proc_name->result
+  && !(sym->attr.dummy || sym->attr.result))
+{
+  if (sym->as && sym->as->type == AS_EXPLICIT)
+   {
+ for (int dim = 0; dim < sym->as->rank; dim++)
+   {
+ if (sym->as->lower[dim]
+ && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
+   front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
+  dependency_fcn, 0);
+ if (front)
+   break;
+ if (sym->as->upper[dim]
+ && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
+   front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
+  dependency_fcn, 0);
+ if (front)
+   break;
+   }
+   }
+
+  if (sym->ts.type == BT_CHARACTER
+ && sym->ts.u.cl && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+   front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
+  dependency_fcn, 0);

This can overwrite a previous front == true, right? Is this intended?

+}
+  return front;
+ }

The rest - besides the front-back confusion - looks fine to me. Thanks for
the
patch.

Regards,
 Andre

On Sun, 9 Jun 2024 07:14:39 +0100
Paul Richard Thomas  wrote:


Hi All,

The attached fixes a problem that, judging by the comments, has been

looked

at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain

in

the wrapped block.

The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix 

Re: [Patch, fortran] PR59104

2024-06-14 Thread Andre Vehreschild
Hi Paul,

to me this looks fine. Thanks for the patch. Me having been away for some time
from gfortran, I recommend you wait for Harald's ok, too.

Regards,
Andre

On Thu, 13 Jun 2024 22:43:03 +0100
Paul Richard Thomas  wrote:

> Hi Both,
>
> Thanks for the highly constructive comments. I think that I have
> incorporated them fully in the attached.
>
> OK for mainline and ...?
>
> Paul
>
>
> On Mon, 10 Jun 2024 at 08:19, Andre Vehreschild  wrote:
>
> > Hi Paul,
> >
> > while looking at your patch I see calls to gfc_add_init_cleanup (...,
> > back),
> > while the function signature is gfc_add_init_cleanup (..., bool front).
> > This
> > slightly confuses me. I would at least expect to see
> > gfc_add_init_cleanup(...,
> > !back) calls. Just to get the semantics right.
> >
> > Then I wonder why not doing:
> >
> > diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
> > index bafe8cbc5bc..97ace8c778e 100644
> > --- a/gcc/fortran/dependency.cc
> > +++ b/gcc/fortran/dependency.cc
> > @@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr
> > *rexpr)
> >return true;
> >  }
> > +
> > +
> > +/* gfc_function_dependency returns true for non-dummy symbols with
> > dependencies
> > +   on an old-fashioned function result (ie. proc_name =
> > proc_name->result).
> > +   This is used to ensure that initialization code appears after the
> > function
> > +   result is treated and that any mutual dependencies between these
> > symbols are
> > +   respected.  */
> > +
> > +static bool
> > +dependency_fcn (gfc_expr *e, gfc_symbol *sym,
> > +int *f ATTRIBUTE_UNUSED)
> > +{
> > +  return (e && e->expr_type == EXPR_VARIABLE
> > +  && e->symtree
> > +  && e->symtree->n.sym == sym);
> > +}
> >
> > Instead of the multiple if-statements?
> >
> > +
> > +bool
> > +gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
> > +{
> > +  bool front = false;
> > +
> > +  if (proc_name && proc_name->attr.function
> > +  && proc_name == proc_name->result
> > +  && !(sym->attr.dummy || sym->attr.result))
> > +{
> > +  if (sym->as && sym->as->type == AS_EXPLICIT)
> > +   {
> > + for (int dim = 0; dim < sym->as->rank; dim++)
> > +   {
> > + if (sym->as->lower[dim]
> > + && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
> > +   front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
> > +  dependency_fcn, 0);
> > + if (front)
> > +   break;
> > + if (sym->as->upper[dim]
> > + && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
> > +   front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
> > +  dependency_fcn, 0);
> > + if (front)
> > +   break;
> > +   }
> > +   }
> > +
> > +  if (sym->ts.type == BT_CHARACTER
> > + && sym->ts.u.cl && sym->ts.u.cl->length
> > + && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
> > +   front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
> > +  dependency_fcn, 0);
> >
> > This can overwrite a previous front == true, right? Is this intended?
> >
> > +}
> > +  return front;
> > + }
> >
> > The rest - besides the front-back confusion - looks fine to me. Thanks for
> > the
> > patch.
> >
> > Regards,
> > Andre
> >
> > On Sun, 9 Jun 2024 07:14:39 +0100
> > Paul Richard Thomas  wrote:
> >
> > > Hi All,
> > >
> > > The attached fixes a problem that, judging by the comments, has been
> > looked
> > > at periodically over the last ten years but just looked to be too
> > > fiendishly complicated to fix. This is not in small part because of the
> > > confusing ordering of dummies in the tlink chain and the unintuitive
> > > placement of all deferred initializations to the front of the init chain
> > in
> > > the wrapped block.
> > >
> > > The result of the existing ordering is that the initialization code for
> > > non-dummy variables that depends on the function result occurs before any
> > > initialization code for the function result itself. The fix ensures that:
> > > (i) These variables are placed correctly in the tlink chain, respecting
> > > inter-dependencies; and (ii) The dependent initializations are placed at
> > > the end of the wrapped block init chain.  The details appear in the
> > > comments in the patch. It is entirely possible that a less clunky fix
> > > exists but I failed to find it.
> > >
> > > OK for mainline?
> > >
> > > Regards
> > >
> > > Paul
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
> >


--
Andre Vehreschild * Email: vehre ad gmx dot de


Re: [Patch, fortran] PR59104

2024-06-13 Thread Paul Richard Thomas
Hi Both,

Thanks for the highly constructive comments. I think that I have
incorporated them fully in the attached.

OK for mainline and ...?

Paul


On Mon, 10 Jun 2024 at 08:19, Andre Vehreschild  wrote:

> Hi Paul,
>
> while looking at your patch I see calls to gfc_add_init_cleanup (...,
> back),
> while the function signature is gfc_add_init_cleanup (..., bool front).
> This
> slightly confuses me. I would at least expect to see
> gfc_add_init_cleanup(...,
> !back) calls. Just to get the semantics right.
>
> Then I wonder why not doing:
>
> diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
> index bafe8cbc5bc..97ace8c778e 100644
> --- a/gcc/fortran/dependency.cc
> +++ b/gcc/fortran/dependency.cc
> @@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr
> *rexpr)
>return true;
>  }
> +
> +
> +/* gfc_function_dependency returns true for non-dummy symbols with
> dependencies
> +   on an old-fashioned function result (ie. proc_name =
> proc_name->result).
> +   This is used to ensure that initialization code appears after the
> function
> +   result is treated and that any mutual dependencies between these
> symbols are
> +   respected.  */
> +
> +static bool
> +dependency_fcn (gfc_expr *e, gfc_symbol *sym,
> +int *f ATTRIBUTE_UNUSED)
> +{
> +  return (e && e->expr_type == EXPR_VARIABLE
> +  && e->symtree
> +  && e->symtree->n.sym == sym);
> +}
>
> Instead of the multiple if-statements?
>
> +
> +bool
> +gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
> +{
> +  bool front = false;
> +
> +  if (proc_name && proc_name->attr.function
> +  && proc_name == proc_name->result
> +  && !(sym->attr.dummy || sym->attr.result))
> +{
> +  if (sym->as && sym->as->type == AS_EXPLICIT)
> +   {
> + for (int dim = 0; dim < sym->as->rank; dim++)
> +   {
> + if (sym->as->lower[dim]
> + && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
> +   front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
> +  dependency_fcn, 0);
> + if (front)
> +   break;
> + if (sym->as->upper[dim]
> + && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
> +   front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
> +  dependency_fcn, 0);
> + if (front)
> +   break;
> +   }
> +   }
> +
> +  if (sym->ts.type == BT_CHARACTER
> + && sym->ts.u.cl && sym->ts.u.cl->length
> + && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
> +   front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
> +  dependency_fcn, 0);
>
> This can overwrite a previous front == true, right? Is this intended?
>
> +}
> +  return front;
> + }
>
> The rest - besides the front-back confusion - looks fine to me. Thanks for
> the
> patch.
>
> Regards,
> Andre
>
> On Sun, 9 Jun 2024 07:14:39 +0100
> Paul Richard Thomas  wrote:
>
> > Hi All,
> >
> > The attached fixes a problem that, judging by the comments, has been
> looked
> > at periodically over the last ten years but just looked to be too
> > fiendishly complicated to fix. This is not in small part because of the
> > confusing ordering of dummies in the tlink chain and the unintuitive
> > placement of all deferred initializations to the front of the init chain
> in
> > the wrapped block.
> >
> > The result of the existing ordering is that the initialization code for
> > non-dummy variables that depends on the function result occurs before any
> > initialization code for the function result itself. The fix ensures that:
> > (i) These variables are placed correctly in the tlink chain, respecting
> > inter-dependencies; and (ii) The dependent initializations are placed at
> > the end of the wrapped block init chain.  The details appear in the
> > comments in the patch. It is entirely possible that a less clunky fix
> > exists but I failed to find it.
> >
> > OK for mainline?
> >
> > Regards
> >
> > Paul
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index fb4d94de641..e299508e53a 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2465,3 +2465,85 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr *rexpr)
 
   return true;
 }
+
+
+/* gfc_function_dependency returns true for non-dummy symbols with dependencies
+   on an old-fashioned function result (ie. proc_name = proc_name->result).
+   This is used to ensure that initialization code appears after the function
+   result is treated and that any mutual dependencies between these symbols are
+   respected.  */
+
+static bool
+dependency_fcn (gfc_expr *e, gfc_symbol *sym,
+		 int *f ATTRIBUTE_UNUSED)
+{
+  if (e == NULL)
+return false;
+
+  if (e && e->expr_type == 

Re: [Patch, fortran] PR59104

2024-06-10 Thread Andre Vehreschild
Hi Paul,

while looking at your patch I see calls to gfc_add_init_cleanup (..., back),
while the function signature is gfc_add_init_cleanup (..., bool front). This
slightly confuses me. I would at least expect to see gfc_add_init_cleanup(...,
!back) calls. Just to get the semantics right.

Then I wonder why not doing:

diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index bafe8cbc5bc..97ace8c778e 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr
*rexpr)
   return true;
 }
+
+
+/* gfc_function_dependency returns true for non-dummy symbols with dependencies
+   on an old-fashioned function result (ie. proc_name = proc_name->result).
+   This is used to ensure that initialization code appears after the function
+   result is treated and that any mutual dependencies between these symbols are
+   respected.  */
+
+static bool
+dependency_fcn (gfc_expr *e, gfc_symbol *sym,
+int *f ATTRIBUTE_UNUSED)
+{
+  return (e && e->expr_type == EXPR_VARIABLE
+  && e->symtree
+  && e->symtree->n.sym == sym);
+}

Instead of the multiple if-statements?

+
+bool
+gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
+{
+  bool front = false;
+
+  if (proc_name && proc_name->attr.function
+  && proc_name == proc_name->result
+  && !(sym->attr.dummy || sym->attr.result))
+{
+  if (sym->as && sym->as->type == AS_EXPLICIT)
+   {
+ for (int dim = 0; dim < sym->as->rank; dim++)
+   {
+ if (sym->as->lower[dim]
+ && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
+   front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
+  dependency_fcn, 0);
+ if (front)
+   break;
+ if (sym->as->upper[dim]
+ && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
+   front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
+  dependency_fcn, 0);
+ if (front)
+   break;
+   }
+   }
+
+  if (sym->ts.type == BT_CHARACTER
+ && sym->ts.u.cl && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+   front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
+  dependency_fcn, 0);

This can overwrite a previous front == true, right? Is this intended?

+}
+  return front;
+ }

The rest - besides the front-back confusion - looks fine to me. Thanks for the
patch.

Regards,
Andre

On Sun, 9 Jun 2024 07:14:39 +0100
Paul Richard Thomas  wrote:

> Hi All,
>
> The attached fixes a problem that, judging by the comments, has been looked
> at periodically over the last ten years but just looked to be too
> fiendishly complicated to fix. This is not in small part because of the
> confusing ordering of dummies in the tlink chain and the unintuitive
> placement of all deferred initializations to the front of the init chain in
> the wrapped block.
>
> The result of the existing ordering is that the initialization code for
> non-dummy variables that depends on the function result occurs before any
> initialization code for the function result itself. The fix ensures that:
> (i) These variables are placed correctly in the tlink chain, respecting
> inter-dependencies; and (ii) The dependent initializations are placed at
> the end of the wrapped block init chain.  The details appear in the
> comments in the patch. It is entirely possible that a less clunky fix
> exists but I failed to find it.
>
> OK for mainline?
>
> Regards
>
> Paul


--
Andre Vehreschild * Email: vehre ad gmx dot de


Re: [Patch, fortran] PR59104

2024-06-10 Thread Paul Richard Thomas
Hi Harald,

Thanks for the loophole detection! It is obvious now I see it, as is the
fix. I'll get on to it as soon as I find some time.

Cheers

Paul


On Sun, 9 Jun 2024 at 21:35, Harald Anlauf  wrote:

> Hi Paul,
>
> your approach sounds entirely reasonable.
>
> But as the following addition to the testcase shows, there seem to
> be loopholes left.
>
> When I add the following to function f:
>
>   integer :: l1(size(y))
>   integer :: l2(size(z))
>   print *, size (l1), size (l2), size (z)
>
> I get:
>
> 0   0   3
>
> Expected:
>
> 2   3   3
>
> Can you please check?
>
> Thanks,
> Harald
>
>
> Am 09.06.24 um 17:57 schrieb Paul Richard Thomas:
> > Hi All,
> >
> > I have extended the testcase - see below and have
> > s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.
> >
> > Cheers
> >
> > Paul
> >
> > ! { dg-do run }
> > !
> > ! Fix for PR59104 in which the dependence on the old style function
> result
> > ! was not taken into account in the ordering of auto array allocation and
> > ! characters with dependent lengths.
> > !
> > ! Contributed by Tobias Burnus  
> > !
> > module m
> > implicit none
> > integer, parameter :: dp = kind([double precision::])
> > contains
> >function f(x)
> >   integer, intent(in) :: x
> >   real(dp) f(x/2)
> >   real(dp) g(x/2)
> >   integer y(size (f)+1) ! This was the original problem
> >   integer z(size (f) + size (y)) ! Found in development of the
> fix
> >   integer w(size (f) + size (y) + x) ! Check dummy is OK
> >   f = 10.0
> >   y = 1! Stop -Wall from complaining
> >   z = 1
> >   g = 1
> >   w = 1
> >   if (size (f) .ne. 1) stop 1
> >   if (size (g) .ne. 1) stop 2
> >   if (size (y) .ne. 2) stop 3
> >   if (size (z) .ne. 3) stop 4
> >   if (size (w) .ne. 5) stop 5
> >end function f
> >function e(x) result(f)
> >   integer, intent(in) :: x
> >   real(dp) f(x/2)
> >   real(dp) g(x/2)
> >   integer y(size (f)+1)
> >   integer z(size (f) + size (y)) ! As was this.
> >   integer w(size (f) + size (y) + x)
> >   f = 10.0
> >   y = 1
> >   z = 1
> >   g = 1
> >   w = 1
> >   if (size (f) .ne. 2) stop 6
> >   if (size (g) .ne. 2) stop 7
> >   if (size (y) .ne. 3) stop 8
> >   if (size (z) .ne. 5) stop 9
> >   if (size (w) .ne. 9) stop 10
> >end function
> >function d(x)  ! After fixes to arrays, what was needed was known!
> >  integer, intent(in) :: x
> >  character(len = x/2) :: d
> >  character(len = len (d)) :: line
> >  character(len = len (d) + len (line)) :: line2
> >  character(len = len (d) + len (line) + x) :: line3
> >  line = repeat ("a", len (d))
> >  line2 = repeat ("b", x)
> >  line3 = repeat ("c", len (line3))
> >  if (len (line2) .ne. x) stop 11
> >  if (line3 .ne. "") stop 12
> >  d = line
> >end
> > end module m
> >
> > program p
> > use m
> > implicit none
> > real(dp) y
> >
> > y = sum (f (2))
> > if (int (y) .ne. 10) stop 13
> > y = sum (e (4))
> > if (int (y) .ne. 20) stop 14
> > if (d (4) .ne. "aa") stop 15
> > end program p
> >
> >
> >
> > On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
> > paul.richard.tho...@gmail.com> wrote:
> >
> >> Hi All,
> >>
> >> The attached fixes a problem that, judging by the comments, has been
> >> looked at periodically over the last ten years but just looked to be too
> >> fiendishly complicated to fix. This is not in small part because of the
> >> confusing ordering of dummies in the tlink chain and the unintuitive
> >> placement of all deferred initializations to the front of the init
> chain in
> >> the wrapped block.
> >>
> >> The result of the existing ordering is that the initialization code for
> >> non-dummy variables that depends on the function result occurs before
> any
> >> initialization code for the function result itself. The fix ensures
> that:
> >> (i) These variables are placed correctly in the tlink chain, respecting
> >> inter-dependencies; and (ii) The dependent initializations are placed at
> >> the end of the wrapped block init chain.  The details appear in the
> >> comments in the patch. It is entirely possible that a less clunky fix
> >> exists but I failed to find it.
> >>
> >> OK for mainline?
> >>
> >> Regards
> >>
> >> Paul
> >>
> >>
> >>
> >>
> >
>
>


Re: [Patch, fortran] PR59104

2024-06-09 Thread Harald Anlauf

Hi Paul,

your approach sounds entirely reasonable.

But as the following addition to the testcase shows, there seem to
be loopholes left.

When I add the following to function f:

 integer :: l1(size(y))
 integer :: l2(size(z))
 print *, size (l1), size (l2), size (z)

I get:

   0   0   3

Expected:

   2   3   3

Can you please check?

Thanks,
Harald


Am 09.06.24 um 17:57 schrieb Paul Richard Thomas:

Hi All,

I have extended the testcase - see below and have
s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.

Cheers

Paul

! { dg-do run }
!
! Fix for PR59104 in which the dependence on the old style function result
! was not taken into account in the ordering of auto array allocation and
! characters with dependent lengths.
!
! Contributed by Tobias Burnus  
!
module m
implicit none
integer, parameter :: dp = kind([double precision::])
contains
   function f(x)
  integer, intent(in) :: x
  real(dp) f(x/2)
  real(dp) g(x/2)
  integer y(size (f)+1) ! This was the original problem
  integer z(size (f) + size (y)) ! Found in development of the fix
  integer w(size (f) + size (y) + x) ! Check dummy is OK
  f = 10.0
  y = 1! Stop -Wall from complaining
  z = 1
  g = 1
  w = 1
  if (size (f) .ne. 1) stop 1
  if (size (g) .ne. 1) stop 2
  if (size (y) .ne. 2) stop 3
  if (size (z) .ne. 3) stop 4
  if (size (w) .ne. 5) stop 5
   end function f
   function e(x) result(f)
  integer, intent(in) :: x
  real(dp) f(x/2)
  real(dp) g(x/2)
  integer y(size (f)+1)
  integer z(size (f) + size (y)) ! As was this.
  integer w(size (f) + size (y) + x)
  f = 10.0
  y = 1
  z = 1
  g = 1
  w = 1
  if (size (f) .ne. 2) stop 6
  if (size (g) .ne. 2) stop 7
  if (size (y) .ne. 3) stop 8
  if (size (z) .ne. 5) stop 9
  if (size (w) .ne. 9) stop 10
   end function
   function d(x)  ! After fixes to arrays, what was needed was known!
 integer, intent(in) :: x
 character(len = x/2) :: d
 character(len = len (d)) :: line
 character(len = len (d) + len (line)) :: line2
 character(len = len (d) + len (line) + x) :: line3
 line = repeat ("a", len (d))
 line2 = repeat ("b", x)
 line3 = repeat ("c", len (line3))
 if (len (line2) .ne. x) stop 11
 if (line3 .ne. "") stop 12
 d = line
   end
end module m

program p
use m
implicit none
real(dp) y

y = sum (f (2))
if (int (y) .ne. 10) stop 13
y = sum (e (4))
if (int (y) .ne. 20) stop 14
if (d (4) .ne. "aa") stop 15
end program p



On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:


Hi All,

The attached fixes a problem that, judging by the comments, has been
looked at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain in
the wrapped block.

The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix ensures that:
(i) These variables are placed correctly in the tlink chain, respecting
inter-dependencies; and (ii) The dependent initializations are placed at
the end of the wrapped block init chain.  The details appear in the
comments in the patch. It is entirely possible that a less clunky fix
exists but I failed to find it.

OK for mainline?

Regards

Paul











Re: [Patch, fortran] PR59104

2024-06-09 Thread Paul Richard Thomas
Hi All,

I have extended the testcase - see below and have
s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.

Cheers

Paul

! { dg-do run }
!
! Fix for PR59104 in which the dependence on the old style function result
! was not taken into account in the ordering of auto array allocation and
! characters with dependent lengths.
!
! Contributed by Tobias Burnus  
!
module m
   implicit none
   integer, parameter :: dp = kind([double precision::])
   contains
  function f(x)
 integer, intent(in) :: x
 real(dp) f(x/2)
 real(dp) g(x/2)
 integer y(size (f)+1) ! This was the original problem
 integer z(size (f) + size (y)) ! Found in development of the fix
 integer w(size (f) + size (y) + x) ! Check dummy is OK
 f = 10.0
 y = 1! Stop -Wall from complaining
 z = 1
 g = 1
 w = 1
 if (size (f) .ne. 1) stop 1
 if (size (g) .ne. 1) stop 2
 if (size (y) .ne. 2) stop 3
 if (size (z) .ne. 3) stop 4
 if (size (w) .ne. 5) stop 5
  end function f
  function e(x) result(f)
 integer, intent(in) :: x
 real(dp) f(x/2)
 real(dp) g(x/2)
 integer y(size (f)+1)
 integer z(size (f) + size (y)) ! As was this.
 integer w(size (f) + size (y) + x)
 f = 10.0
 y = 1
 z = 1
 g = 1
 w = 1
 if (size (f) .ne. 2) stop 6
 if (size (g) .ne. 2) stop 7
 if (size (y) .ne. 3) stop 8
 if (size (z) .ne. 5) stop 9
 if (size (w) .ne. 9) stop 10
  end function
  function d(x)  ! After fixes to arrays, what was needed was known!
integer, intent(in) :: x
character(len = x/2) :: d
character(len = len (d)) :: line
character(len = len (d) + len (line)) :: line2
character(len = len (d) + len (line) + x) :: line3
line = repeat ("a", len (d))
line2 = repeat ("b", x)
line3 = repeat ("c", len (line3))
if (len (line2) .ne. x) stop 11
if (line3 .ne. "") stop 12
d = line
  end
end module m

program p
   use m
   implicit none
   real(dp) y

   y = sum (f (2))
   if (int (y) .ne. 10) stop 13
   y = sum (e (4))
   if (int (y) .ne. 20) stop 14
   if (d (4) .ne. "aa") stop 15
end program p



On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:

> Hi All,
>
> The attached fixes a problem that, judging by the comments, has been
> looked at periodically over the last ten years but just looked to be too
> fiendishly complicated to fix. This is not in small part because of the
> confusing ordering of dummies in the tlink chain and the unintuitive
> placement of all deferred initializations to the front of the init chain in
> the wrapped block.
>
> The result of the existing ordering is that the initialization code for
> non-dummy variables that depends on the function result occurs before any
> initialization code for the function result itself. The fix ensures that:
> (i) These variables are placed correctly in the tlink chain, respecting
> inter-dependencies; and (ii) The dependent initializations are placed at
> the end of the wrapped block init chain.  The details appear in the
> comments in the patch. It is entirely possible that a less clunky fix
> exists but I failed to find it.
>
> OK for mainline?
>
> Regards
>
> Paul
>
>
>
>


[Patch, fortran] PR59104

2024-06-09 Thread Paul Richard Thomas
Hi All,

The attached fixes a problem that, judging by the comments, has been looked
at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain in
the wrapped block.

The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix ensures that:
(i) These variables are placed correctly in the tlink chain, respecting
inter-dependencies; and (ii) The dependent initializations are placed at
the end of the wrapped block init chain.  The details appear in the
comments in the patch. It is entirely possible that a less clunky fix
exists but I failed to find it.

OK for mainline?

Regards

Paul


Change.Logs
Description: Binary data
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index bafe8cbc5bc..97ace8c778e 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr *rexpr)
 
   return true;
 }
+
+
+/* gfc_function_dependency returns true for non-dummy symbols with dependencies
+   on an old-fashioned function result (ie. proc_name = proc_name->result).
+   This is used to ensure that initialization code appears after the function
+   result is treated and that any mutual dependencies between these symbols are
+   respected.  */
+
+static bool
+dependency_fcn (gfc_expr *e, gfc_symbol *sym,
+		 int *f ATTRIBUTE_UNUSED)
+{
+  if (e == NULL)
+return false;
+
+  if (e && e->expr_type == EXPR_VARIABLE
+  && e->symtree
+  && e->symtree->n.sym == sym)
+return true;
+
+  return false;
+}
+
+
+bool
+gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
+{
+  bool front = false;
+
+  if (proc_name && proc_name->attr.function
+  && proc_name == proc_name->result
+  && !(sym->attr.dummy || sym->attr.result))
+{
+  if (sym->as && sym->as->type == AS_EXPLICIT)
+	{
+	  for (int dim = 0; dim < sym->as->rank; dim++)
+	{
+	  if (sym->as->lower[dim]
+		  && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
+		front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
+	   dependency_fcn, 0);
+	  if (front)
+		break;
+	  if (sym->as->upper[dim]
+		  && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
+		front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
+	   dependency_fcn, 0);
+	  if (front)
+		break;
+	}
+	}
+
+  if (sym->ts.type == BT_CHARACTER
+	  && sym->ts.u.cl && sym->ts.u.cl->length
+	  && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
+   dependency_fcn, 0);
+}
+  return front;
+ }
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index ea4bd04b0e8..0fa5f93d0fc 100644
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -23,7 +23,7 @@ enum gfc_dep_check
 {
   NOT_ELEMENTAL,/* Not elemental case: normal dependency check.  */
   ELEM_CHECK_VARIABLE,  /* Test whether variables overlap.  */
-  ELEM_DONT_CHECK_VARIABLE  /* Test whether variables overlap only if used 
+  ELEM_DONT_CHECK_VARIABLE  /* Test whether variables overlap only if used
 			   in an expression.  */
 };
 
@@ -43,3 +43,5 @@ bool gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
 bool gfc_omp_expr_prefix_same (gfc_expr *, gfc_expr *);
 
 gfc_expr * gfc_discard_nops (gfc_expr *);
+
+bool gfc_function_dependency (gfc_symbol *, gfc_symbol *);
\ No newline at end of file
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index 65e38b0e866..60f607ecc4f 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -892,7 +892,7 @@ error_print (const char *type, const char *format0, va_list argp)
 #else
 	  m = INTTYPE_MAXIMUM (ptrdiff_t);
 #endif
-	  m = 2 * m + 1;  
+	  m = 2 * m + 1;
 	  error_uinteger (a & m);
 	}
 	  else
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..7e39981e843 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "parse.h"
 #include "match.h"
 #include "constructor.h"
+#include "dependency.h"
 
 
 /* Strings for all symbol attributes.  We use these for dumping the
@@ -948,15 +949,18 @@ conflict_std:
 void
 gfc_set_sym_referenced (gfc_symbol *sym)
 {
+  gfc_symbol *proc_name = sym->ns->proc_name ? sym->ns->proc_name : NULL;
 
   if (sym->attr.referenced)
 return;
 
   sym->attr.referenced = 1;
 
-  /* Remember which order dummy variables are accessed in.  */
-  if (sym->attr.dummy)
-sym->dummy_order = next_dummy_order++;
+  /* Remember which order dummy variables and symbols with function result
+ dependencies are accessed in.