https://gcc.gnu.org/g:94e4661fee27c5b1362e02690c5047e0b543fc9a
commit r14-10480-g94e4661fee27c5b1362e02690c5047e0b543fc9a
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Sat Jul 20 10:42:40 2024 +0100
Revert "Fortran: Auto array allocation with function dependencies [PR59104]"
This reverts commit 5034af8223c0db07cdec01cef70048ec44cdd47b.
Diff:
---
gcc/fortran/dependency.cc | 82 -----------------------
gcc/fortran/dependency.h | 4 +-
gcc/fortran/error.cc | 2 +-
gcc/fortran/gfortran.h | 6 +-
gcc/fortran/symbol.cc | 10 +++
gcc/fortran/trans-array.cc | 15 +----
gcc/fortran/trans-decl.cc | 51 ++------------
gcc/fortran/trans.cc | 5 +-
gcc/fortran/trans.h | 3 +-
gcc/testsuite/gfortran.dg/dependent_decls_2.f90 | 89 -------------------------
10 files changed, 29 insertions(+), 238 deletions(-)
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 15edf1af9dff..bafe8cbc5bc3 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2497,85 +2497,3 @@ 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 8f172f86f08f..ea4bd04b0e82 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,5 +43,3 @@ 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 60f607ecc4f2..65e38b0e8667 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 5b7c27a5597c..de3d9e25911b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1887,6 +1887,10 @@ 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
@@ -1925,8 +1929,6 @@ 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 2f326492d5fb..5db3c887127b 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -96,6 +96,11 @@ 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;
@@ -936,10 +941,15 @@ conflict:
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 b621f42917c9..761f0a425078 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6871,7 +6871,6 @@ 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));
@@ -6883,12 +6882,6 @@ 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. */
@@ -6916,8 +6909,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol *
sym,
if (onstack)
{
- gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE,
- back);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
return;
}
@@ -7004,11 +6996,10 @@ 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,
- back);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
tmp = NULL_TREE;
}
- gfc_add_init_cleanup (block, inittree, tmp, back);
+ gfc_add_init_cleanup (block, inittree, tmp);
}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 219d9eb797fa..1a319b27449b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -49,7 +49,6 @@ 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,19 +832,6 @@ 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. */
@@ -863,34 +849,18 @@ 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)
{
/* 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. */
+ This is a circular list, so don't go past the head. */
while (p != head
- && (!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;
- }
+ && (!p->attr.dummy || p->dummy_order > sym->dummy_order))
+ {
+ last = p;
+ p = p->tlink;
+ }
}
/* Insert in between last and p. */
last->tlink = sym;
@@ -4206,19 +4176,12 @@ 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);
@@ -4231,7 +4194,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, back);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
/* Set the initial value of ASSIGN statement auxiliary variable explicitly. */
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 721823c251d5..badad6ae8927 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2803,15 +2803,14 @@ 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,
- bool back)
+gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup)
{
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, !back);
+ add_expr_to_chain (&block->init, init, true);
add_expr_to_chain (&block->cleanup, cleanup, false);
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index dc8e91c904f3..2e10ce1a9b34 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -471,8 +471,7 @@ 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,
- bool back = false);
+void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup);
/* 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
deleted file mode 100644
index 73c84ea3bc50..000000000000
--- a/gcc/testsuite/gfortran.dg/dependent_decls_2.f90
+++ /dev/null
@@ -1,89 +0,0 @@
-! { 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 <bur...@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
