From 0e792ee11aa6ebb6f61e9ed33eb06e260f0ec703 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 22 Mar 2021 09:49:48 +0100 Subject: Fortran: Fix 'name' bound size [PR99688] gcc/fortran/ChangeLog: PR fortran/99688 * match.c (select_type_set_tmp, gfc_match_select_type, gfc_match_select_rank): Fix 'name' buffersize to avoid out of bounds. * resolve.c (resolve_select_type): Likewise. --- gcc/fortran/resolve.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 32015c2..715fecd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9246,7 +9246,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_code *class_is = NULL, *default_case = NULL; gfc_case *c; gfc_symtree *st; - char name[GFC_MAX_SYMBOL_LEN]; + char name[GFC_MAX_SYMBOL_LEN + 12 + 1]; gfc_namespace *ns; int error = 0; int rank = 0; -- cgit v1.1 From b179026a5d9fcadadef6ca511933933672557495 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 24 Mar 2021 07:50:22 +0100 Subject: Fortran: Extend buffer, use snprintf to avoid overflows [PR99369] gcc/fortran/ChangeLog: PR fortran/99369 * resolve.c (resolve_operator): Make 'msg' buffer larger and use snprintf. gcc/testsuite/ChangeLog: PR fortran/99369 * gfortran.dg/longnames.f90: New test. --- gcc/fortran/resolve.c | 82 ++++++++++++++++++++++++++++----------------------- 1 file changed, 45 insertions(+), 37 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 715fecd..1c9b0c5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3994,7 +3994,8 @@ static bool resolve_operator (gfc_expr *e) { gfc_expr *op1, *op2; - char msg[200]; + /* One error uses 3 names; additional space for wording (also via gettext). */ + char msg[3*GFC_MAX_SYMBOL_LEN + 1 + 50]; bool dual_locus_error; bool t = true; @@ -4047,7 +4048,8 @@ resolve_operator (gfc_expr *e) if ((op1 && op1->expr_type == EXPR_NULL) || (op2 && op2->expr_type == EXPR_NULL)) { - sprintf (msg, _("Invalid context for NULL() pointer at %%L")); + snprintf (msg, sizeof (msg), + _("Invalid context for NULL() pointer at %%L")); goto bad_op; } @@ -4063,8 +4065,9 @@ resolve_operator (gfc_expr *e) break; } - sprintf (msg, _("Operand of unary numeric operator %%<%s%%> at %%L is %s"), - gfc_op2string (e->value.op.op), gfc_typename (e)); + snprintf (msg, sizeof (msg), + _("Operand of unary numeric operator %%<%s%%> at %%L is %s"), + gfc_op2string (e->value.op.op), gfc_typename (e)); goto bad_op; case INTRINSIC_PLUS: @@ -4079,14 +4082,14 @@ resolve_operator (gfc_expr *e) } if (op1->ts.type == BT_DERIVED || op2->ts.type == BT_DERIVED) - sprintf (msg, - _("Unexpected derived-type entities in binary intrinsic " - "numeric operator %%<%s%%> at %%L"), + snprintf (msg, sizeof (msg), + _("Unexpected derived-type entities in binary intrinsic " + "numeric operator %%<%s%%> at %%L"), gfc_op2string (e->value.op.op)); else - sprintf (msg, - _("Operands of binary numeric operator %%<%s%%> at %%L are %s/%s"), - gfc_op2string (e->value.op.op), gfc_typename (op1), + snprintf (msg, sizeof(msg), + _("Operands of binary numeric operator %%<%s%%> at %%L are %s/%s"), + gfc_op2string (e->value.op.op), gfc_typename (op1), gfc_typename (op2)); goto bad_op; @@ -4099,9 +4102,9 @@ resolve_operator (gfc_expr *e) break; } - sprintf (msg, - _("Operands of string concatenation operator at %%L are %s/%s"), - gfc_typename (op1), gfc_typename (op2)); + snprintf (msg, sizeof (msg), + _("Operands of string concatenation operator at %%L are %s/%s"), + gfc_typename (op1), gfc_typename (op2)); goto bad_op; case INTRINSIC_AND: @@ -4142,9 +4145,10 @@ resolve_operator (gfc_expr *e) goto simplify_op; } - sprintf (msg, _("Operands of logical operator %%<%s%%> at %%L are %s/%s"), - gfc_op2string (e->value.op.op), gfc_typename (op1), - gfc_typename (op2)); + snprintf (msg, sizeof (msg), + _("Operands of logical operator %%<%s%%> at %%L are %s/%s"), + gfc_op2string (e->value.op.op), gfc_typename (op1), + gfc_typename (op2)); goto bad_op; @@ -4165,8 +4169,8 @@ resolve_operator (gfc_expr *e) break; } - sprintf (msg, _("Operand of .not. operator at %%L is %s"), - gfc_typename (op1)); + snprintf (msg, sizeof (msg), _("Operand of .not. operator at %%L is %s"), + gfc_typename (op1)); goto bad_op; case INTRINSIC_GT: @@ -4276,16 +4280,16 @@ resolve_operator (gfc_expr *e) } if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) - sprintf (msg, - _("Logicals at %%L must be compared with %s instead of %s"), - (e->value.op.op == INTRINSIC_EQ - || e->value.op.op == INTRINSIC_EQ_OS) - ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op)); + snprintf (msg, sizeof (msg), + _("Logicals at %%L must be compared with %s instead of %s"), + (e->value.op.op == INTRINSIC_EQ + || e->value.op.op == INTRINSIC_EQ_OS) + ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op)); else - sprintf (msg, - _("Operands of comparison operator %%<%s%%> at %%L are %s/%s"), - gfc_op2string (e->value.op.op), gfc_typename (op1), - gfc_typename (op2)); + snprintf (msg, sizeof (msg), + _("Operands of comparison operator %%<%s%%> at %%L are %s/%s"), + gfc_op2string (e->value.op.op), gfc_typename (op1), + gfc_typename (op2)); goto bad_op; @@ -4296,19 +4300,23 @@ resolve_operator (gfc_expr *e) const char *guessed; guessed = lookup_uop_fuzzy (name, e->value.op.uop->ns->uop_root); if (guessed) - sprintf (msg, _("Unknown operator %%<%s%%> at %%L; did you mean '%s'?"), - name, guessed); + snprintf (msg, sizeof (msg), + _("Unknown operator %%<%s%%> at %%L; did you mean '%s'?"), + name, guessed); else - sprintf (msg, _("Unknown operator %%<%s%%> at %%L"), name); + snprintf (msg, sizeof (msg), _("Unknown operator %%<%s%%> at %%L"), + name); } else if (op2 == NULL) - sprintf (msg, _("Operand of user operator %%<%s%%> at %%L is %s"), - e->value.op.uop->name, gfc_typename (op1)); + snprintf (msg, sizeof (msg), + _("Operand of user operator %%<%s%%> at %%L is %s"), + e->value.op.uop->name, gfc_typename (op1)); else { - sprintf (msg, _("Operands of user operator %%<%s%%> at %%L are %s/%s"), - e->value.op.uop->name, gfc_typename (op1), - gfc_typename (op2)); + snprintf (msg, sizeof (msg), + _("Operands of user operator %%<%s%%> at %%L are %s/%s"), + e->value.op.uop->name, gfc_typename (op1), + gfc_typename (op2)); e->value.op.uop->op->sym->attr.referenced = 1; } @@ -4391,8 +4399,8 @@ resolve_operator (gfc_expr *e) /* Try user-defined operators, and otherwise throw an error. */ dual_locus_error = true; - sprintf (msg, - _("Inconsistent ranks for operator at %%L and %%L")); + snprintf (msg, sizeof (msg), + _("Inconsistent ranks for operator at %%L and %%L")); goto bad_op; } } -- cgit v1.1 From 98c5b5924de969ae8ab37d140aa85bcca3f3c76c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= Date: Fri, 16 Apr 2021 16:17:21 +0000 Subject: Fortran: Fix ICE due to referencing a NULL pointer [PR100018] gcc/fortran/ChangeLog: PR fortran/100018 * resolve.c: Add association check before de-referencing pointer. gcc/testsuite/ChangeLog: PR fortran/100018 * gfortran.dg/PR10018.f90: New test. --- gcc/fortran/resolve.c | 1 + 1 file changed, 1 insertion(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1c9b0c5..dd4b266 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11999,6 +11999,7 @@ start: /* Assigning a class object always is a regular assign. */ if (code->expr2->ts.type == BT_CLASS && code->expr1->ts.type == BT_CLASS + && CLASS_DATA (code->expr2) && !CLASS_DATA (code->expr2)->attr.dimension && !(gfc_expr_attr (code->expr1).proc_pointer && code->expr2->expr_type == EXPR_VARIABLE -- cgit v1.1 From a61c4964cd71446232d62ec9b10a7d45b440dd9f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 21 Apr 2021 10:58:29 +0200 Subject: Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset in the depend clause. (show_omp_clauses, show_omp_node, show_code_node): Handle depobj. * gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ. (enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET, OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ. (gfc_omp_clauses): Add destroy, depobj_update and depobj. (enum gfc_exec_op): Add EXEC_OMP_DEPOBJ * match.h (gfc_match_omp_depobj): Match 'omp depobj'. * openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset to depend clause. (gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive): Handle 'omp depobj'. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset in the depend clause. (gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/depobj-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/depobj-1.f90: New test. * gfortran.dg/gomp/depobj-2.f90: New test. --- gcc/fortran/resolve.c | 1 + 1 file changed, 1 insertion(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index dd4b266..5a81387 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12198,6 +12198,7 @@ start: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: + case EXEC_OMP_DEPOBJ: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: -- cgit v1.1 From 62e1bd651f60cfe3daaad91b41b7612bc7fa7460 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 14 May 2021 19:19:26 +0200 Subject: Fortran/OpenMP: Handle implicit SAVE for variables in main gcc/fortran/ChangeLog: * resolve.c (resolve_symbol): Handle implicit SAVE of main-program for vars in 'omp threadprivate' and 'omp declare target'. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/implicit-save.f90: New test. --- gcc/fortran/resolve.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5a81387..83b41a3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -16039,7 +16039,8 @@ resolve_symbol (gfc_symbol *sym) && !(sym->ns->save_all && !sym->attr.automatic) && sym->module == NULL && (sym->ns->proc_name == NULL - || sym->ns->proc_name->attr.flavor != FL_MODULE)) + || (sym->ns->proc_name->attr.flavor != FL_MODULE + && !sym->ns->proc_name->attr.is_main_program))) gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at); /* Check omp declare target restrictions. */ @@ -16050,7 +16051,8 @@ resolve_symbol (gfc_symbol *sym) && (!sym->attr.in_common && sym->module == NULL && (sym->ns->proc_name == NULL - || sym->ns->proc_name->attr.flavor != FL_MODULE))) + || (sym->ns->proc_name->attr.flavor != FL_MODULE + && !sym->ns->proc_name->attr.is_main_program)))) gfc_error ("!$OMP DECLARE TARGET variable %qs at %L isn't SAVEd", sym->name, &sym->declared_at); -- cgit v1.1 From 0e3702f8daeec5897982d185650b78a5c1c53c25 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 14 May 2021 19:21:47 +0200 Subject: Fortran/OpenMP: Support 'omp parallel master' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_PARALLEL_MASTER. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and ST_OMP_END_PARALLEL_MASTER. (enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER.. * match.h (gfc_match_omp_parallel_master): Handle it. * openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses, omp_code_to_statement, gfc_resolve_omp_directive): Likewise. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_parallel_master, gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/parallel-master.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/parallel-master-1.f90: New test. * gfortran.dg/gomp/parallel-master-2.f90: New test. --- gcc/fortran/resolve.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 83b41a3..c02bbed 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10802,6 +10802,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: @@ -11763,6 +11764,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: @@ -12243,6 +12245,7 @@ start: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: omp_workshare_save = omp_workshare_flag; -- cgit v1.1 From 582776eb1b62c32f5234566a01ea92247b7d6bcc Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 17 May 2021 13:20:27 +0200 Subject: OpenMP/Fortran: Reject nonintrinsic assignments in OMP WORKSHARE [PR100633] PR fortran/100633 gcc/fortran/ChangeLog: * resolve.c (gfc_resolve_code): Reject nonintrinsic assignments in OMP WORKSHARE. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/workshare-59.f90: New test. --- gcc/fortran/resolve.c | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c02bbed..747516f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11940,6 +11940,12 @@ start: if (resolve_ordinary_assign (code, ns)) { + if (omp_workshare_flag) + { + gfc_error ("Expected intrinsic assignment in OMP WORKSHARE " + "at %L", &code->loc); + break; + } if (code->op == EXEC_COMPCALL) goto compcall; else -- cgit v1.1 From f6bf436d9ab907d090823895abb7a2d5ba7ff50c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 1 Jun 2021 12:46:37 +0200 Subject: Fortran/OpenMP: Support (parallel) master taskloop (simd) [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle (parallel) master taskloop (simd). * frontend-passes.c (gfc_code_walker): Set in_omp_workshare to false for parallel master taskloop (simd). * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD). (enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD). * match.h (gfc_match_omp_master_taskloop, gfc_match_omp_master_taskloop_simd, gfc_match_omp_parallel_master_taskloop, gfc_match_omp_parallel_master_taskloop_simd): New prototype. * openmp.c (gfc_match_omp_parallel_master_taskloop, gfc_match_omp_parallel_master_taskloop_simd, gfc_match_omp_master_taskloop, gfc_match_omp_master_taskloop_simd): New. (gfc_match_omp_taskloop_simd): Permit 'reduction' clause. (resolve_omp_clauses): Handle new combined directives; remove inscan-reduction check to reduce multiple errors; add task-reduction error for 'taskloop simd'. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle new combined constructs. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans.c (trans_code): Likewise. * trans-openmp.c (gfc_split_omp_clauses, gfc_trans_omp_directive): Likewise. (gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop; handle parallel master taskloop (simd) as well. (gfc_trans_omp_taskloop): Take gfc_exec_op as arg. (gfc_trans_omp_master_taskloop): New. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/reduction5.f90: Remove dg-error; the issue is now diagnosed with less error output. * gfortran.dg/gomp/scan-1.f90: Likewise. * gfortran.dg/gomp/pr99928-3.f90: New test. * gfortran.dg/gomp/taskloop-1.f90: New test. --- gcc/fortran/resolve.c | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 747516f..fed6dce 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10798,11 +10798,15 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: + case EXEC_OMP_MASTER_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_MASTER: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: @@ -11765,6 +11769,8 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_MASTER: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: @@ -12214,6 +12220,8 @@ start: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: + case EXEC_OMP_MASTER_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: @@ -12252,6 +12260,8 @@ start: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_MASTER: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: omp_workshare_save = omp_workshare_flag; -- cgit v1.1 From 178191e1dfafd8db149edcdef7a39e9e2c00f216 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 12:06:59 +0200 Subject: Fortran/OpenMP: Add omp loop [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle bind clause. (show_omp_node): Handle loop directive. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP. (enum gfc_omp_bind_type): New. (gfc_omp_clauses): Use it. (enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP. * match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_teams_loop): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND. (gfc_match_omp_clauses): Handle it. (OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop): New. (resolve_omp_clauses, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp loop. * parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_executable): Likewise. (parse_omp_structured_block): Remove ST_ which use parse_omp_do. * resolve.c (gfc_resolve_blocks): Add omp loop. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause. (gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute, gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive): Handle loop directive. (gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate and (in_)reduction for taskloop. * trans.c (trans_code): Handle omp loop directive. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-3.f90: Add 'default(none)', following C/C++ version of the patch. * gfortran.dg/gomp/loop-1.f90: New test. * gfortran.dg/gomp/loop-2.f90: New test. * gfortran.dg/gomp/pr99928-1.f90: New test; based on C/C++ test. * gfortran.dg/gomp/pr99928-11.f90: Likewise. * gfortran.dg/gomp/pr99928-2.f90: Likewise. * gfortran.dg/gomp/pr99928-4.f90: Likewise. * gfortran.dg/gomp/pr99928-5.f90: Likewise. * gfortran.dg/gomp/pr99928-6.f90: Likewise. * gfortran.dg/gomp/pr99928-8.f90: Likewise. * gfortran.dg/goacc/omp.f95: Use 'acc kernels loops' instead of 'acc loops' to hide unrelated bug for now. * gfortran.dg/goacc/omp-fixed.f: Likewise --- gcc/fortran/resolve.c | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fed6dce..a37ad66 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10797,6 +10797,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -10804,6 +10805,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_LOOP: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -10819,12 +10821,14 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_LOOP: case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_LOOP: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: @@ -10836,6 +10840,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_LOOP: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: break; @@ -12219,6 +12224,7 @@ start: case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -12234,12 +12240,14 @@ start: case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_LOOP: case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_LOOP: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: @@ -12252,6 +12260,7 @@ start: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_LOOP: case EXEC_OMP_WORKSHARE: gfc_resolve_omp_directive (code, ns); break; @@ -12259,6 +12268,7 @@ start: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_LOOP: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: -- cgit v1.1 From a893b26f7311fe65b604f12a8fa5d5d64f5454e2 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 14 Jun 2021 14:36:20 +0200 Subject: Fortran: resolve.c - remove '*XCNEW' based nullifying gcc/fortran/ChangeLog: * resolve.c (resolve_variable): Remove *XCNEW used to nullify nullified memory. --- gcc/fortran/resolve.c | 1 - 1 file changed, 1 deletion(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index a37ad66..45c3ad3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5709,7 +5709,6 @@ resolve_variable (gfc_expr *e) part_ref. */ gfc_ref *ref = gfc_get_ref (); ref->type = REF_ARRAY; - ref->u.ar = *gfc_get_array_ref(); ref->u.ar.type = AR_FULL; if (sym->as) { -- cgit v1.1 From 7bf582e6cfcef922a087b1b2b42aa04ea9cb2d94 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 28 Jul 2021 19:11:27 +0200 Subject: Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument gcc/fortran/ChangeLog: PR fortran/101564 * expr.c (gfc_check_vardef_context): Add check for KIND and LEN parameter inquiries. * match.c (gfc_match): Fix comment for %v code. (gfc_match_allocate, gfc_match_deallocate): Replace use of %v code by %e in gfc_match to allow for function references as STAT and ERRMSG arguments. * resolve.c (resolve_allocate_deallocate): Avoid NULL pointer dereferences and shortcut for bad STAT and ERRMSG argument to (DE)ALLOCATE. Remove bogus parts of checks for STAT and ERRMSG. gcc/testsuite/ChangeLog: PR fortran/101564 * gfortran.dg/allocate_stat_3.f90: New test. * gfortran.dg/allocate_stat.f90: Adjust error messages. * gfortran.dg/implicit_11.f90: Likewise. * gfortran.dg/inquiry_type_ref_3.f90: Likewise. --- gcc/fortran/resolve.c | 35 ++++++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 11 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 45c3ad3..5923646 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8155,16 +8155,21 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) /* Check the stat variable. */ if (stat) { - gfc_check_vardef_context (stat, false, false, false, - _("STAT variable")); + if (!gfc_check_vardef_context (stat, false, false, false, + _("STAT variable"))) + goto done_stat; - if ((stat->ts.type != BT_INTEGER - && !(stat->ref && (stat->ref->type == REF_ARRAY - || stat->ref->type == REF_COMPONENT))) + if (stat->ts.type != BT_INTEGER || stat->rank > 0) gfc_error ("Stat-variable at %L must be a scalar INTEGER " "variable", &stat->where); + if (stat->expr_type == EXPR_CONSTANT || stat->symtree == NULL) + goto done_stat; + + /* F2018:9.7.4: The stat-variable shall not be allocated or deallocated + * within the ALLOCATE or DEALLOCATE statement in which it appears ... + */ for (p = code->ext.alloc.list; p; p = p->next) if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name) { @@ -8192,6 +8197,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) } } +done_stat: + /* Check the errmsg variable. */ if (errmsg) { @@ -8199,22 +8206,26 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) gfc_warning (0, "ERRMSG at %L is useless without a STAT tag", &errmsg->where); - gfc_check_vardef_context (errmsg, false, false, false, - _("ERRMSG variable")); + if (!gfc_check_vardef_context (errmsg, false, false, false, + _("ERRMSG variable"))) + goto done_errmsg; /* F18:R928 alloc-opt is ERRMSG = errmsg-variable F18:R930 errmsg-variable is scalar-default-char-variable F18:R906 default-char-variable is variable F18:C906 default-char-variable shall be default character. */ - if ((errmsg->ts.type != BT_CHARACTER - && !(errmsg->ref - && (errmsg->ref->type == REF_ARRAY - || errmsg->ref->type == REF_COMPONENT))) + if (errmsg->ts.type != BT_CHARACTER || errmsg->rank > 0 || errmsg->ts.kind != gfc_default_character_kind) gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER " "variable", &errmsg->where); + if (errmsg->expr_type == EXPR_CONSTANT || errmsg->symtree == NULL) + goto done_errmsg; + + /* F2018:9.7.5: The errmsg-variable shall not be allocated or deallocated + * within the ALLOCATE or DEALLOCATE statement in which it appears ... + */ for (p = code->ext.alloc.list; p; p = p->next) if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name) { @@ -8242,6 +8253,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) } } +done_errmsg: + /* Check that an allocate-object appears only once in the statement. */ for (p = code->ext.alloc.list; p; p = p->next) -- cgit v1.1 From bbf19f9c20515da9fcd23f08c8139427374e8d77 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 15 Aug 2021 20:13:11 +0200 Subject: Fortran: fix checks for STAT= and ERRMSG= arguments of SYNC ALL/SYNC IMAGES gcc/fortran/ChangeLog: PR fortran/99351 * match.c (sync_statement): Replace %v code by %e in gfc_match to allow for function references as STAT and ERRMSG arguments. * resolve.c (resolve_sync): Adjust checks of STAT= and ERRMSG= to being definable arguments. Function references with a data pointer result are accepted. * trans-stmt.c (gfc_trans_sync): Adjust assertion. gcc/testsuite/ChangeLog: PR fortran/99351 * gfortran.dg/coarray_sync.f90: New test. * gfortran.dg/coarray_3.f90: Adjust error messages. --- gcc/fortran/resolve.c | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5923646..959f0be 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10236,19 +10236,27 @@ resolve_sync (gfc_code *code) /* Check STAT. */ gfc_resolve_expr (code->expr2); - if (code->expr2 - && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0 - || code->expr2->expr_type != EXPR_VARIABLE)) - gfc_error ("STAT= argument at %L must be a scalar INTEGER variable", - &code->expr2->where); + if (code->expr2) + { + if (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0) + gfc_error ("STAT= argument at %L must be a scalar INTEGER variable", + &code->expr2->where); + else + gfc_check_vardef_context (code->expr2, false, false, false, + _("STAT variable")); + } /* Check ERRMSG. */ gfc_resolve_expr (code->expr3); - if (code->expr3 - && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0 - || code->expr3->expr_type != EXPR_VARIABLE)) - gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable", - &code->expr3->where); + if (code->expr3) + { + if (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0) + gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable", + &code->expr3->where); + else + gfc_check_vardef_context (code->expr3, false, false, false, + _("ERRMSG variable")); + } } -- cgit v1.1 From 53d5b59cb3b417ab8293702aacc75a9bbb3ead78 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 16 Aug 2021 09:26:26 +0200 Subject: Fortran/OpenMP: Add support for OpenMP 5.1 masked construct Commit r12-2891-gd0befed793b94f3f407be44e6f69f81a02f5f073 added C/C++ support for the masked construct. This patch extends it to Fortran. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause. (show_omp_node, show_code_node): Handle (combined) omp masked construct. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*. (enum gfc_exec_op): Add EXEC_OMP_*_MASKED*. * match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd): New prototypes. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER. (gfc_match_omp_clauses): Match it. (OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd, gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd): New. (resolve_omp_clauses): Resolve filter clause. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp masked constructs. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause. (GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values. (gfc_trans_omp_masked): New. (gfc_split_omp_clauses): Handle combined masked directives. (gfc_trans_omp_master_taskloop): Rename to ... (gfc_trans_omp_master_masked_taskloop): ... this; handle also combined masked directives. (gfc_trans_omp_parallel_master): Rename to ... (gfc_trans_omp_parallel_master_masked): ... this; handle combined masked directives. (gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/masked-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/masked-1.f90: New test. * gfortran.dg/gomp/masked-2.f90: New test. * gfortran.dg/gomp/masked-3.f90: New test. * gfortran.dg/gomp/masked-combined-1.f90: New test. * gfortran.dg/gomp/masked-combined-2.f90: New test. --- gcc/fortran/resolve.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 959f0be..8eb8a9a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10818,6 +10818,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_LOOP: + case EXEC_OMP_MASKED: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -10826,6 +10829,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -11793,6 +11799,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -12248,6 +12257,9 @@ start: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASKED: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: @@ -12289,6 +12301,9 @@ start: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: -- cgit v1.1 From f8d535f3fec81c1cc84e22df5500e693544ec65b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 17 Aug 2021 15:50:11 +0200 Subject: Fortran: Implement OpenMP 5.1 scope construct Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f, which implemented OpenMP's scope construct for C and C++. Most testcases are based on the C testcases; it also contains some testcases which existed previously but had no Fortran equivalent. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_SCOPE. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE. (enum gfc_exec_op): Add EXEC_OMP_SCOPE. * match.h (gfc_match_omp_scope): New. * openmp.c (OMP_SCOPE_CLAUSES): Define (gfc_match_omp_scope): New. (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait): Improve error diagnostic. (omp_code_to_statement): Handle ST_OMP_SCOPE. (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Handle OpenMP's scope construct. * resolve.c (gfc_resolve_blocks): Likewise * st.c (gfc_free_statement): Likewise * trans-openmp.c (gfc_trans_omp_scope): New. (gfc_trans_omp_directive): Call it. * trans.c (trans_code): handle EXEC_OMP_SCOPE. libgomp/ChangeLog: * testsuite/libgomp.fortran/scope-1.f90: New test. * testsuite/libgomp.fortran/task-reduction-16.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/scan-1.f90: * gfortran.dg/gomp/cancel-1.f90: New test. * gfortran.dg/gomp/cancel-4.f90: New test. * gfortran.dg/gomp/loop-4.f90: New test. * gfortran.dg/gomp/nesting-1.f90: New test. * gfortran.dg/gomp/nesting-2.f90: New test. * gfortran.dg/gomp/nesting-3.f90: New test. * gfortran.dg/gomp/nowait-1.f90: New test. * gfortran.dg/gomp/reduction-task-1.f90: New test. * gfortran.dg/gomp/reduction-task-2.f90: New test. * gfortran.dg/gomp/reduction-task-2a.f90: New test. * gfortran.dg/gomp/reduction-task-3.f90: New test. * gfortran.dg/gomp/scope-1.f90: New test. * gfortran.dg/gomp/scope-2.f90: New test. --- gcc/fortran/resolve.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8eb8a9a..117062b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10839,6 +10839,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: + case EXEC_OMP_SCOPE: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: @@ -12262,6 +12263,7 @@ start: case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: case EXEC_OMP_SCAN: + case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: -- cgit v1.1 From 77167196fe8cf840a69913e7739d39ae0df2b074 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 20 Aug 2021 12:12:51 +0200 Subject: Fortran: Add OpenMP's error directive Fortran part to the C/C++ implementation of commit r12-3040-g0d973c0a0d90a0a302e7eda1a4d9709be3c5b102 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity' and 'message' clauses. (show_omp_node, show_code_node): Handle EXEC_OMP_ERROR. * gfortran.h (gfc_statement): Add ST_OMP_ERROR. (gfc_omp_severity_type, gfc_omp_at_type): New. (gfc_omp_clauses): Add 'at', 'severity' and 'message' clause; use more bitfields + ENUM_BITFIELD. (gfc_exec_op): Add EXEC_OMP_ERROR. * match.h (gfc_match_omp_error): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE). (gfc_match_omp_clauses): Handle new clauses. (OMP_ERROR_CLAUSES, gfc_match_omp_error): New. (resolve_omp_clauses): Resolve new clauses. (omp_code_to_statement, gfc_resolve_omp_directive): Handle EXEC_OMP_ERROR. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Handle 'omp error'. * resolve.c (gfc_resolve_blocks): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_error): Likewise. (gfc_trans_omp_directive): Likewise. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/error-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/error-1.f90: New test. * gfortran.dg/gomp/error-2.f90: New test. * gfortran.dg/gomp/error-3.f90: New test. --- gcc/fortran/resolve.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 117062b..5b9ba43 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10817,6 +10817,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ERROR: case EXEC_OMP_LOOP: case EXEC_OMP_MASKED: case EXEC_OMP_MASKED_TASKLOOP: @@ -12254,6 +12255,7 @@ start: case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ERROR: case EXEC_OMP_LOOP: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: -- cgit v1.1 From f9809ef57005409ee658294d6e8dad9ee8897e88 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sat, 28 Aug 2021 20:09:44 +0200 Subject: Fortran - reject function entries with mismatched characteristics gcc/fortran/ChangeLog: PR fortran/87737 * resolve.c (resolve_entries): For functions of type CHARACTER tighten the checks for matching characteristics. gcc/testsuite/ChangeLog: PR fortran/87737 * gfortran.dg/entry_24.f90: New test. --- gcc/fortran/resolve.c | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5b9ba43..f641d0d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -804,6 +804,15 @@ resolve_entries (gfc_namespace *ns) the same string length, i.e. both len=*, or both len=4. Having both len= is also possible, but difficult to check at compile time. */ + else if (ts->type == BT_CHARACTER + && (el->sym->result->attr.allocatable + != ns->entries->sym->result->attr.allocatable)) + { + gfc_error ("Function %s at %L has entry %s with mismatched " + "characteristics", ns->entries->sym->name, + &ns->entries->sym->declared_at, el->sym->name); + return; + } else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl && (((ts->u.cl->length && !fts->u.cl->length) ||(!ts->u.cl->length && fts->u.cl->length)) -- cgit v1.1 From 9213ff13247739d6d335064a6b568278a872a991 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 30 Aug 2021 22:41:01 +0200 Subject: Fortran - correct check for constraint F2008:C628 / F2018:C932 gcc/fortran/ChangeLog: PR fortran/101349 * resolve.c (resolve_allocate_expr): An unlimited polymorphic argument to ALLOCATE must be ALLOCATABLE or a POINTER. Fix the corresponding check. gcc/testsuite/ChangeLog: PR fortran/101349 * gfortran.dg/unlimited_polymorphic_33.f90: New test. --- gcc/fortran/resolve.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f641d0d..d7aa286 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7829,8 +7829,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) } } - /* Check for F08:C628. */ - if (allocatable == 0 && pointer == 0 && !unlimited) + /* Check for F08:C628 (F2018:C932). Each allocate-object shall be a data + pointer or an allocatable variable. */ + if (allocatable == 0 && pointer == 0) { gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER", &e->where); -- cgit v1.1 From a88280cff3436d0b6ab454514e5a3b97a543e9a5 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 1 Sep 2021 19:05:47 +0200 Subject: Fortran - improve wording of error message gcc/fortran/ChangeLog: PR fortran/56985 * resolve.c (resolve_common_vars): Fix grammar and improve wording of error message rejecting an unlimited polymorphic in COMMON. --- gcc/fortran/resolve.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d7aa286..8e5ed1c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -979,7 +979,7 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common) } if (UNLIMITED_POLY (csym)) - gfc_error_now ("%qs in cannot appear in COMMON at %L " + gfc_error_now ("%qs at %L cannot appear in COMMON " "[F2008:C5100]", csym->name, &csym->declared_at); if (csym->ts.type != BT_DERIVED) -- cgit v1.1