* [Patch, fortran] PR59104 @ 2024-06-09 6:14 Paul Richard Thomas 2024-06-09 15:57 ` Paul Richard Thomas 2024-06-10 7:19 ` Andre Vehreschild 0 siblings, 2 replies; 9+ messages in thread From: Paul Richard Thomas @ 2024-06-09 6:14 UTC (permalink / raw) To: fortran, gcc-patches [-- 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-09 6:14 [Patch, fortran] PR59104 Paul Richard Thomas @ 2024-06-09 15:57 ` Paul Richard Thomas 2024-06-09 20:35 ` Harald Anlauf 2024-06-10 7:19 ` Andre Vehreschild 1 sibling, 1 reply; 9+ messages in thread From: Paul Richard Thomas @ 2024-06-09 15:57 UTC (permalink / raw) To: fortran, gcc-patches [-- 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 > > > > ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-09 15:57 ` Paul Richard Thomas @ 2024-06-09 20:35 ` Harald Anlauf 2024-06-10 6:22 ` Paul Richard Thomas 0 siblings, 1 reply; 9+ messages in thread From: Harald Anlauf @ 2024-06-09 20:35 UTC (permalink / raw) To: Paul Richard Thomas, fortran, gcc-patches 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 >> >> >> >> > ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-09 20:35 ` Harald Anlauf @ 2024-06-10 6:22 ` Paul Richard Thomas 0 siblings, 0 replies; 9+ messages in thread From: Paul Richard Thomas @ 2024-06-10 6:22 UTC (permalink / raw) To: Harald Anlauf; +Cc: fortran, gcc-patches [-- 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 > >> > >> > >> > >> > > > > ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-09 6:14 [Patch, fortran] PR59104 Paul Richard Thomas 2024-06-09 15:57 ` Paul Richard Thomas @ 2024-06-10 7:19 ` Andre Vehreschild 2024-06-13 21:43 ` Paul Richard Thomas 1 sibling, 1 reply; 9+ messages in thread From: Andre Vehreschild @ 2024-06-10 7:19 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: fortran, gcc-patches 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-10 7:19 ` Andre Vehreschild @ 2024-06-13 21:43 ` Paul Richard Thomas 2024-06-14 7:48 ` Andre Vehreschild 2024-06-14 20:40 ` Harald Anlauf 0 siblings, 2 replies; 9+ messages in thread From: Paul Richard Thomas @ 2024-06-13 21:43 UTC (permalink / raw) To: Andre Vehreschild, Harald Anlauf; +Cc: fortran, gcc-patches [-- 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. ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-13 21:43 ` Paul Richard Thomas @ 2024-06-14 7:48 ` Andre Vehreschild 2024-06-14 9:12 ` Paul Richard Thomas 2024-06-14 20:40 ` Harald Anlauf 1 sibling, 1 reply; 9+ messages in thread From: Andre Vehreschild @ 2024-06-14 7:48 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: Harald Anlauf, fortran, gcc-patches 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-14 7:48 ` Andre Vehreschild @ 2024-06-14 9:12 ` Paul Richard Thomas 0 siblings, 0 replies; 9+ messages in thread From: Paul Richard Thomas @ 2024-06-14 9:12 UTC (permalink / raw) To: Andre Vehreschild; +Cc: Harald Anlauf, fortran [-- 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 > ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch, fortran] PR59104 2024-06-13 21:43 ` Paul Richard Thomas 2024-06-14 7:48 ` Andre Vehreschild @ 2024-06-14 20:40 ` Harald Anlauf 1 sibling, 0 replies; 9+ messages in thread From: Harald Anlauf @ 2024-06-14 20:40 UTC (permalink / raw) To: Paul Richard Thomas, Andre Vehreschild; +Cc: fortran, gcc-patches 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 >> > ^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2024-06-14 20:40 UTC | newest] Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2024-06-09 6:14 [Patch, fortran] PR59104 Paul Richard Thomas 2024-06-09 15:57 ` Paul Richard Thomas 2024-06-09 20:35 ` Harald Anlauf 2024-06-10 6:22 ` Paul Richard Thomas 2024-06-10 7:19 ` Andre Vehreschild 2024-06-13 21:43 ` Paul Richard Thomas 2024-06-14 7:48 ` Andre Vehreschild 2024-06-14 9:12 ` Paul Richard Thomas 2024-06-14 20:40 ` Harald Anlauf
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).