Two fixes – simple, see patch + commit text.
Longer description:
* options:
Background:
- OpenMP, OpenACC and imply that a function is called
concurrently and -frecursive implies recusive. In all those
cases, the code may fail if a local variable is in static memory
instead of stack or heap. – If a user specified 'save', we
can assume/hope that they will deal with it - but with
-fno-automatic (→ 'save' implied), the flags clash.
- Additionally, to avoid placing local arrays in static memory,
for -fopenmp/-fopenacc -frecursive and 'unlimited' stack size
use for const-size arrays is implied.
This patch:
- Handle OpenACC as OpenMP (before it didn't imply -frecursive.
* Recursive run-time check. The current code currently generates:
subroutine foo()
logical, save :: currently_called = .false.
if (currently_called) error_stop "No recursive but called"
currently_called = .true.
...
... ! Rest of code, which could indirectly call this proc again
...
currently_called = .false.
end
This works well for recursive calls but less so for concurrency
(→ OpenMP, OpenACC).
As noted above, by default OpenMP/OpenACC implies -frecursive
and, hence, there is no recursive check generated.
The question is what code should be generated for, e.g.
-fno-automatic -fopenmp or -fopenacc -fmax-stack-var-size=20
In that case, -frecursive is unset. We have two choices:
- Either still always reset, which may not detect concurrent
use (including recursive + concurrent use) do to a race condition.
- Or avoid resetting the flag
But then calling the procedure twice (e.g. beginning + end of the
program) will generate a bogus error.
The current code does the second – at least for -fopenmp.
→ PATCH: Simply use the same condition twice instead of a complicated
test; do so via: 'if (recurcheckvar == NULL_TREE)'.
Current code:
tree recurcheckvar = NULL_TREE;
...
if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
&& !is_recursive && !flag_recursive && !sym->attr.artificial)
... // declare 'recurcheckvar', generate error-message code etc.
...
/* Reset recursion-check variable. */
if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
&& !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE)
Comments? Suggestions? – If not, I will commit it as obvious in the next
days.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander
Walter
Fortran: -fno-automatic and -fopenacc / recusion check cleanup
Options: -fopenmp and -fopenacc imply concurrent calls to a
procedure; now also -fopenacc implies -frecursive, disabling
that larger local const-size array variables use static memory.
Run-time recursion check: Always reset the check variable at the
end of the procedure; this avoids a bogus error with -fopenmp
when called twice nonconcurrently/nonrecursively. (Issue requires
using -fno-automatic or -fmax-stack-var-size= to trigger.)
gcc/fortran/ChangeLog:
PR fortran/98010
PR fortran/98013
* options.c (gfc_post_options): Also imply recursive with
-fopenacc.
* trans-decl.c (gfc_generate_function_code): Simplify condition.
gcc/fortran/options.c | 16 +++++++++-------
gcc/fortran/trans-decl.c | 3 +--
2 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index d844fa93115..66be1d586fb 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -407,32 +407,34 @@ gfc_post_options (const char **pfilename)
if (!flag_automatic && flag_max_stack_var_size != -2
&& flag_max_stack_var_size != 0)
gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
flag_max_stack_var_size);
else if (!flag_automatic && flag_recursive)
gfc_warning_now (OPT_Woverwrite_recursive, "Flag %<-fno-automatic%> "
"overwrites %<-frecursive%>");
- else if (!flag_automatic && flag_openmp)
- gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
- "%<-fopenmp%>");
+ else if (!flag_automatic && (flag_openmp || flag_openacc))
+ gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> "
+ "implied by %qs", flag_openmp ? "-fopenmp" : "-fopenacc");
else if (flag_max_stack_var_size != -2 && flag_recursive)
gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
flag_max_stack_var_size);
- else if (flag_max_stack_var_size != -2 && flag_openmp)
- gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
- "implied by %<-fopenmp%>", flag_max_stack_var_size);
+ else if (flag_max_stack_var_size != -2 && (flag_openmp || flag_openacc))
+ gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites "
+ "%<-frecursive%> implied by %qs", flag_max_stack_var_size,
+ flag_openmp ? "-fopenmp" : "-fopenacc");
/* Implement -frecursive as -fmax-stack-var-size=-1. */
if (flag_recursive)
flag_max_stack_var_size = -1;
/* Implied -frecursive; implemented as -fmax-stack-var-size=-1. */
- if (flag_max_stack_var_size == -2 && flag_openmp && flag_automatic)
+ if (flag_max_stack_var_size == -2 && flag_automatic
+ && (flag_openmp || flag_openacc))
{
flag_recursive = 1;
flag_max_stack_var_size = -1;
}
/* Set flag_stack_arrays correctly. */
if (flag_stack_arrays == -1)
flag_stack_arrays = 0;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 71d5c670e55..d45900a5ca5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -6965,8 +6965,7 @@ gfc_generate_function_code (gfc_namespace * ns)
gfc_init_block (&cleanup);
/* Reset recursion-check variable. */
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
- && !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE)
+ if (recurcheckvar != NULL_TREE)
{
gfc_add_modify (&cleanup, recurcheckvar, logical_false_node);
recurcheckvar = NULL;
