[Patch, fortran] PR59104

[Patch, fortran] PR59104

[Paul Richard Thomas]

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

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

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

Fortran: Put auto array allocation and character length conversion with
function result dependency in the correct order [PR59104]

2024-06-09  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/59104
	* dependency.cc (dependency_fcn, gfc_function_dependency): New
	functions to detect dependency in array bounds and character
	lengths on old style function results.
	* dependency.h : Add prototype for gfc_function_dependency.
	* error.cc (error_print): Remove trailing space.
	* symbol.cc : Include dependency.h.
	(gfc_set_sym_referenced): Set dummy_order for symbols with fcn
	dependencies.
	* trans-array.cc (gfc_trans_auto_array_allocation): Detect
	non-dummy symbols with function dependencies and put the
	allocation at the end of the initialization code.
	* trans-decl.cc : Include dependency.h.
	(gfc_defer_symbol_init): Call gfc_function_dependency to put
	dependent symbols in the right part of the tlink chain.
	(gfc_trans_auto_character_variable): Put character length
	initialization of dependent symbols at the end of the chain.
	* trans.cc (gfc_add_init_cleanup): Add boolean argument with
	default true that determines whther an expression is placed at
	the back or the front of the initialization chain.
	* trans.h : Update the prototype for gfc_add_init_cleanup.

gcc/testsuite/
	PR fortran/59104
	* gfortran.dg/dependent_decls_2: New test.

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

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.  */
+  if (sym->attr.dummy
+      || (proc_name && gfc_function_dependency (sym, proc_name)))
+  sym->dummy_order = next_dummy_order++;
 }
 
 
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c5b56f4e273..678cbb6a138 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6864,6 +6864,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
   tree space;
   tree inittree;
   bool onstack;
+  bool back;
 
   gcc_assert (!(sym->attr.pointer || sym->attr.allocatable));
 
@@ -6875,6 +6876,12 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
   gcc_assert (GFC_ARRAY_TYPE_P (type));
   onstack = TREE_CODE (type) != POINTER_TYPE;
 
+  /* In the case of non-dummy symbols with dependencies on an old-fashioned
+     function result (ie. proc_name = proc_name->result), gfc_add_init_cleanup
+     must be called with the last, optional argument false so that the alloc-
+     ation occurs after the processing of the result.  */
+  back = !gfc_function_dependency (sym, sym->ns->proc_name);
+
   gfc_init_block (&init);
 
   /* Evaluate character string length.  */
@@ -6902,7 +6909,8 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
 
   if (onstack)
     {
-      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE,
+			    back);
       return;
     }
 
@@ -6989,10 +6997,11 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
       addr = fold_build1_loc (gfc_get_location (&sym->declared_at),
 			      ADDR_EXPR, TREE_TYPE (decl), space);
       gfc_add_modify (&init, decl, addr);
-      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE,
+			    back);
       tmp = NULL_TREE;
     }
-  gfc_add_init_cleanup (block, inittree, tmp);
+  gfc_add_init_cleanup (block, inittree, tmp, back);
 }
 
 
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dca7779528b..cb34a0401d1 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -49,6 +49,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "omp-general.h"
 #include "attr-fnspec.h"
 #include "tree-iterator.h"
+#include "dependency.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -842,6 +843,7 @@ gfc_defer_symbol_init (gfc_symbol * sym)
   gfc_symbol *p;
   gfc_symbol *last;
   gfc_symbol *head;
+  bool back;
 
   /* Don't add a symbol twice.  */
   if (sym->tlink)
@@ -850,6 +852,8 @@ gfc_defer_symbol_init (gfc_symbol * sym)
   last = head = sym->ns->proc_name;
   p = last->tlink;
 
+  back = gfc_function_dependency (sym, head);
+
   /* Make sure that setup code for dummy variables which are used in the
      setup of other variables is generated first.  */
   if (sym->attr.dummy)
@@ -863,6 +867,20 @@ gfc_defer_symbol_init (gfc_symbol * sym)
           p = p->tlink;
         }
     }
+  else if (back)
+    {
+      /* In the case of non-dummy symbols with dependencies on an old-fashioned
+     function result (ie. proc_name = proc_name->result), make sure that the
+     order in the tlink chain is such that the code appears in declaration
+     order. This ensures that mutual dependencies between these symbols are
+     respected.  */
+      while (p != head
+             && (!p->attr.result || p->dummy_order < sym->dummy_order))
+        {
+          last = p;
+          p = p->tlink;
+        }
+    }
   /* Insert in between last and p.  */
   last->tlink = sym;
   sym->tlink = p;
@@ -4183,12 +4201,19 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
   stmtblock_t init;
   tree decl;
   tree tmp;
+  bool back;
 
   gcc_assert (sym->backend_decl);
   gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length);
 
   gfc_init_block (&init);
 
+  /* In the case of non-dummy symbols with dependencies on an old-fashioned
+     function result (ie. proc_name = proc_name->result), gfc_add_init_cleanup
+     must be called with the last, optional argument false so that the process
+     ing of the character length occurs after the processing of the result.  */
+  back = !gfc_function_dependency (sym, sym->ns->proc_name);
+
   /* Evaluate the string length expression.  */
   gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
 
@@ -4201,7 +4226,7 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
   tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl), decl);
   gfc_add_expr_to_block (&init, tmp);
 
-  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE, back);
 }
 
 /* Set the initial value of ASSIGN statement auxiliary variable explicitly.  */
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index badad6ae892..b133221eb3b 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2803,14 +2803,15 @@ gfc_start_wrapped_block (gfc_wrapped_block* block, tree code)
 /* Add a new pair of initializers/clean-up code.  */
 
 void
-gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup)
+gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup,
+		      bool front)
 {
   gcc_assert (block);
 
   /* The new pair of init/cleanup should be "wrapped around" the existing
      block of code, thus the initialization is added to the front and the
      cleanup to the back.  */
-  add_expr_to_chain (&block->init, init, true);
+  add_expr_to_chain (&block->init, init, front);
   add_expr_to_chain (&block->cleanup, cleanup, false);
 }
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f94fa601400..a940b8960f8 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -471,7 +471,8 @@ void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
 void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code);
 /* Add a pair of init/cleanup code to the block.  Each one might be a
    NULL_TREE if not required.  */
-void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup);
+void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup,
+			   bool front = true);
 /* Finalize the block, that is, create a single expression encapsulating the
    original code together with init and clean-up code.  */
 tree gfc_finish_wrapped_block (gfc_wrapped_block* block);
diff --git a/gcc/testsuite/gfortran.dg/dependent_decls_2.f90 b/gcc/testsuite/gfortran.dg/dependent_decls_2.f90
new file mode 100644
index 00000000000..5b7bdd27a40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependent_decls_2.f90
@@ -0,0 +1,63 @@
+! { 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  <burnus@gcc.gnu.org>
+!
+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
+         f = 10.0
+         y = 1                        ! Stop -Wall from complaining
+         z = 1
+         g = 1
+         if (size(f) .ne. 1) stop 1
+         if (size(y) .ne. 2) stop 2
+         if (size(z) .ne. 3) stop 3
+      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.
+         f = 10.0
+         y = 1
+         z = 1
+         g = 1
+         if (size(f) .ne. 2) stop 4
+         if (size(y) .ne. 3) stop 5
+         if (size(z) .ne. 5) stop 6
+      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)) :: line_plus
+        line = repeat ("a", len (d))
+        line_plus = repeat ("b", x)
+        if (len (line_plus) .ne. x) stop 7
+        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 8
+   y = sum(e(4))
+   if (int (y) .ne. 20) stop 9
+   if (d(4) .ne. "aa") stop 10
+end program p

Re: [Patch, fortran] PR59104

[Paul Richard Thomas]

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

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  <burnus@gcc.gnu.org>
!
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. "cccccccc") 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.thomas@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

[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  <burnus@gcc.gnu.org>
> !
> 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. "cccccccc") 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.thomas@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

[Paul Richard Thomas]

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

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 <anlauf@gmx.de> 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  <burnus@gcc.gnu.org>
> > !
> > 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. "cccccccc") 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.thomas@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

[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 <paul.richard.thomas@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


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

Re: [Patch, fortran] PR59104

[Paul Richard Thomas]

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

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 <vehre@gmx.de> 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 <paul.richard.thomas@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
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>

[-- Attachment #2: resubmit.diff --]
[-- Type: text/x-patch, Size: 15648 bytes --]

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 == EXPR_VARIABLE)
+    {
+      if (e->symtree && e->symtree->n.sym == sym)
+	return true;
+      /* Recurse to see if this symbol is dependent on the function result. If
+	 so an indirect dependence exists, which should be handled in the same
+	 way as a direct dependence. The recursion is prevented from being
+	 infinite by statement order.  */
+      else if (e->symtree && e->symtree->n.sym)
+	return gfc_function_dependency (e->symtree->n.sym, sym);
+    }
+
+  return false;
+}
+
+
+bool
+gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
+{
+  bool dep = false;
+
+  if (proc_name && proc_name->attr.function
+      && proc_name == proc_name->result
+      && !(sym->attr.dummy || sym->attr.result))
+    {
+      if (sym->fn_result_dep)
+	return true;
+
+      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)
+		dep = gfc_traverse_expr (sym->as->lower[dim], proc_name,
+					 dependency_fcn, 0);
+	      if (dep)
+		{
+		  sym->fn_result_dep = 1;
+		  return true;
+		}
+	      if (sym->as->upper[dim]
+		  && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
+		dep = gfc_traverse_expr (sym->as->upper[dim], proc_name,
+					 dependency_fcn, 0);
+	      if (dep)
+		{
+		  sym->fn_result_dep = 1;
+		  return true;
+		}
+	    }
+	}
+
+      if (sym->ts.type == BT_CHARACTER
+	  && sym->ts.u.cl && sym->ts.u.cl->length
+	  && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	dep = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
+				 dependency_fcn, 0);
+      if (dep)
+	{
+	  sym->fn_result_dep = 1;
+	  return true;
+	}
+    }
+
+  return false;
+ }
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index ea4bd04b0e8..8f172f86f08 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 *);
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/gfortran.h b/gcc/fortran/gfortran.h
index de1a7cd0935..7fcc3ea051a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1888,10 +1888,6 @@ typedef struct gfc_symbol
      points to C and B's is NULL.  */
   struct gfc_common_head* common_head;
 
-  /* Make sure setup code for dummy arguments is generated in the correct
-     order.  */
-  int dummy_order;
-
   gfc_namelist *namelist, *namelist_tail;
 
   /* The tlink field is used in the front end to carry the module
@@ -1930,6 +1926,8 @@ typedef struct gfc_symbol
   unsigned forall_index:1;
   /* Set if the symbol is used in a function result specification .  */
   unsigned fn_result_spec:1;
+  /* Set if the symbol spec. depends on an old-style function result.  */
+  unsigned fn_result_dep:1;
   /* Used to avoid multiple resolutions of a single symbol.  */
   /* = 2 if this has already been resolved as an intrinsic,
        in gfc_resolve_intrinsic,
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..cf3d83a5431 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -96,11 +96,6 @@ const mstring dtio_procs[] =
     minit ("_dtio_unformatted_write", DTIO_WUF),
 };
 
-/* This is to make sure the backend generates setup code in the correct
-   order.  */
-
-static int next_dummy_order = 1;
-
 
 gfc_namespace *gfc_current_ns;
 gfc_namespace *gfc_global_ns_list;
@@ -948,15 +943,10 @@ conflict_std:
 void
 gfc_set_sym_referenced (gfc_symbol *sym)
 {
-
   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++;
 }
 
 
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c5b56f4e273..664667596da 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6864,6 +6864,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
   tree space;
   tree inittree;
   bool onstack;
+  bool back;
 
   gcc_assert (!(sym->attr.pointer || sym->attr.allocatable));
 
@@ -6875,6 +6876,12 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
   gcc_assert (GFC_ARRAY_TYPE_P (type));
   onstack = TREE_CODE (type) != POINTER_TYPE;
 
+  /* In the case of non-dummy symbols with dependencies on an old-fashioned
+     function result (ie. proc_name = proc_name->result), gfc_add_init_cleanup
+     must be called with the last, optional argument false so that the alloc-
+     ation occurs after the processing of the result.  */
+  back = sym->fn_result_dep;
+
   gfc_init_block (&init);
 
   /* Evaluate character string length.  */
@@ -6902,7 +6909,8 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
 
   if (onstack)
     {
-      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE,
+			    back);
       return;
     }
 
@@ -6989,10 +6997,11 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
       addr = fold_build1_loc (gfc_get_location (&sym->declared_at),
 			      ADDR_EXPR, TREE_TYPE (decl), space);
       gfc_add_modify (&init, decl, addr);
-      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE,
+			    back);
       tmp = NULL_TREE;
     }
-  gfc_add_init_cleanup (block, inittree, tmp);
+  gfc_add_init_cleanup (block, inittree, tmp, back);
 }
 
 
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dca7779528b..dc37a98f55c 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -49,6 +49,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "omp-general.h"
 #include "attr-fnspec.h"
 #include "tree-iterator.h"
+#include "dependency.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -833,6 +834,19 @@ gfc_allocate_lang_decl (tree decl)
     DECL_LANG_SPECIFIC (decl) = ggc_cleared_alloc<struct lang_decl> ();
 }
 
+
+/* Determine order of two symbol declarations.  */
+
+static bool
+decl_order (gfc_symbol *sym1, gfc_symbol *sym2)
+{
+  if (sym1->declared_at.lb->location > sym2->declared_at.lb->location)
+    return true;
+  else
+    return false;
+}
+
+
 /* Remember a symbol to generate initialization/cleanup code at function
    entry/exit.  */
 
@@ -850,6 +864,8 @@ gfc_defer_symbol_init (gfc_symbol * sym)
   last = head = sym->ns->proc_name;
   p = last->tlink;
 
+  gfc_function_dependency (sym, head);
+
   /* Make sure that setup code for dummy variables which are used in the
      setup of other variables is generated first.  */
   if (sym->attr.dummy)
@@ -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)))
         {
           last = p;
           p = p->tlink;
         }
     }
+  else if (sym->fn_result_dep)
+    {
+      /* In the case of non-dummy symbols with dependencies on an old-fashioned
+     function result (ie. proc_name = proc_name->result), make sure that the
+     order in the tlink chain is such that the code appears in declaration
+     order. This ensures that mutual dependencies between these symbols are
+     respected.  */
+      while (p != head
+	     && (!p->attr.result || decl_order (sym, p)))
+	{
+	  last = p;
+	  p = p->tlink;
+	}
+    }
   /* Insert in between last and p.  */
   last->tlink = sym;
   sym->tlink = p;
@@ -4183,12 +4213,19 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
   stmtblock_t init;
   tree decl;
   tree tmp;
+  bool back;
 
   gcc_assert (sym->backend_decl);
   gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length);
 
   gfc_init_block (&init);
 
+  /* In the case of non-dummy symbols with dependencies on an old-fashioned
+     function result (ie. proc_name = proc_name->result), gfc_add_init_cleanup
+     must be called with the last, optional argument false so that the process
+     ing of the character length occurs after the processing of the result.  */
+  back = sym->fn_result_dep;
+
   /* Evaluate the string length expression.  */
   gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
 
@@ -4201,7 +4238,7 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
   tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl), decl);
   gfc_add_expr_to_block (&init, tmp);
 
-  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE, back);
 }
 
 /* Set the initial value of ASSIGN statement auxiliary variable explicitly.  */
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index badad6ae892..721823c251d 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2803,14 +2803,15 @@ gfc_start_wrapped_block (gfc_wrapped_block* block, tree code)
 /* Add a new pair of initializers/clean-up code.  */
 
 void
-gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup)
+gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup,
+		      bool back)
 {
   gcc_assert (block);
 
   /* The new pair of init/cleanup should be "wrapped around" the existing
      block of code, thus the initialization is added to the front and the
      cleanup to the back.  */
-  add_expr_to_chain (&block->init, init, true);
+  add_expr_to_chain (&block->init, init, !back);
   add_expr_to_chain (&block->cleanup, cleanup, false);
 }
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f94fa601400..bcf599cd0ac 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -471,7 +471,8 @@ void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
 void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code);
 /* Add a pair of init/cleanup code to the block.  Each one might be a
    NULL_TREE if not required.  */
-void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup);
+void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup,
+			   bool back = false);
 /* Finalize the block, that is, create a single expression encapsulating the
    original code together with init and clean-up code.  */
 tree gfc_finish_wrapped_block (gfc_wrapped_block* block);
diff --git a/gcc/testsuite/gfortran.dg/pr59104.f90 b/gcc/testsuite/gfortran.dg/pr59104.f90
new file mode 100644
index 00000000000..73c84ea3bc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr59104.f90
@@ -0,0 +1,89 @@
+! { 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  <burnus@gcc.gnu.org>
+!
+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
+         integer :: l1(size(y))
+         integer :: l2(size(z))
+         integer :: l3(size(w))
+         f = 10.0
+         y = 1                              ! Stop -Wall from complaining
+         z = 1; g = 1; w = 1; l1 = 1; l2 = 1; l3 = 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
+         if (size (l1) .ne. 2) stop 6       ! Check indirect dependencies
+         if (size (l2) .ne. 3) stop 7
+         if (size (l3) .ne. 5) stop 8
+
+      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)
+         integer :: l1(size(y))
+         integer :: l2(size(z))
+         integer :: l3(size(w))
+         f = 10.0
+         y = 1; z = 1; g = 1; w = 1; l1 = 1; l2 = 1; l3 = 1
+         if (size (f) .ne. 2) stop 9
+         if (size (g) .ne. 2) stop 10
+         if (size (y) .ne. 3) stop 11
+         if (size (z) .ne. 5) stop 12
+         if (size (w) .ne. 9) stop 13
+         if (size (l1) .ne. 3) stop 14      ! Check indirect dependencies
+         if (size (l2) .ne. 5) stop 15
+         if (size (l3) .ne. 9) stop 16
+      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
+! 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
+        line = repeat ("a", len (d))
+        line2 = repeat ("b", x)
+        line3 = repeat ("c", len (line3))
+        if (len (line2) .ne. x) stop 17
+        if (line3 .ne. "cccccccc") stop 18
+        d = line
+        line4 = line3
+        if (size (line4) .ne. 8) stop 19
+        if (any (line4 .ne. "cccccccc")) stop 20
+      end
+end module m
+
+program p
+   use m
+   implicit none
+   real(dp) y
+
+   y = sum (f (2))
+   if (int (y) .ne. 10) stop 21
+   y = sum (e (4))
+   if (int (y) .ne. 20) stop 22
+   if (d (4) .ne. "aa") stop 23
+end program p

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

Fortran: Put auto array allocation and character length conversion with
function result dependency in the correct order [PR59104]

2024-06-13  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/59104
	* dependency.cc (dependency_fcn, gfc_function_dependency): New
	functions to detect dependency in array bounds and character
	lengths on old style function results.
	* dependency.h : Add prototype for gfc_function_dependency.
	* error.cc (error_print): Remove trailing space.
	* gfortran.h : Remove dummy_order and add fn_result_spec.
	* symbol.cc : Remove declaration of next_dummy_order..
	(gfc_set_sym_referenced): remove setting of symbol dummy order.
	* trans-array.cc (gfc_trans_auto_array_allocation): Detect
	non-dummy symbols with function dependencies and put the
	allocation at the end of the initialization code.
	* trans-decl.cc : Include dependency.h.
	(decl_order): New function that determines uses the location
	field of the symbol 'declared_at' to determine the order of two
	declarations.
	(gfc_defer_symbol_init): Call gfc_function_dependency to put
	dependent symbols in the right part of the tlink chain. Use
	the location field of the symbol declared_at to determine the
	order of declarations.
	(gfc_trans_auto_character_variable): Put character length
	initialization of dependent symbols at the end of the chain.
	* trans.cc (gfc_add_init_cleanup): Add boolean argument with
	default false that determines whther an expression is placed at
	the back or the front of the initialization chain.
	* trans.h : Update the prototype for gfc_add_init_cleanup.

gcc/testsuite/
	PR fortran/59104
	* gfortran.dg/dependent_decls_2.f90: New test.

Re: [Patch, fortran] PR59104

[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 <paul.richard.thomas@gmail.com> 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 <vehre@gmx.de> 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 <paul.richard.thomas@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
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
> >


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

Re: [Patch, fortran] PR59104

[Paul Richard Thomas]

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

Hi Andre,

Thanks - I will wait for Harald, if for no other reason than I just don't
have time today to do the commit :-)

BTW Note the commented out lines in the testcase. They fail in the front
end for reasons that I am not sure are correct. Interestingly, nagfor does
the same. Ifort fails on many of the lines that the patched gfortran and
nagfor accept. Any insights from anybody? The declaration order looks OK to
me and, I would have thought, they could be fixed up in resolution.

Cheers

Paul


On Fri, 14 Jun 2024 at 08:48, Andre Vehreschild <vehre@gmx.de> wrote:

> 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 <paul.richard.thomas@gmail.com> 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 <vehre@gmx.de> 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 <paul.richard.thomas@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
> > >
> > >
> > > --
> > > Andre Vehreschild * Email: vehre ad gmx dot de
> > >
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>

Re: [Patch, fortran] PR59104

[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 <vehre@gmx.de> 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 <paul.richard.thomas@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
>>
>>
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de
>>
>