From 3011f1046628d5ce5e6e5f8e917a6aea1385fdc3 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 4 Jun 2021 11:17:05 +0200 Subject: c++: Fix up attribute handling in methods in templates [PR100872] The following testcase FAILs because a dependent (late) attribute is never tsubsted. While the testcase is OpenMP, I think it is a generic C++ FE problem that could affect any other dependent attribute. apply_late_template_attributes documents that it relies on /* save_template_attributes puts the dependent attributes at the beginning of the list; find the non-dependent ones. */ The "operator binding" attributes that are sometimes added are added to the head of DECL_ATTRIBUTES list though and because it doesn't have ATTR_IS_DEPENDENT set it violates this requirement. The following patch fixes it by adding that attribute after all ATTR_IS_DEPENDENT attributes. I'm not 100% sure if DECL_ATTRIBUTES can't be shared by multiple functions (e.g. the cdtor clones), but the code uses later remove_attribute which could break that too. Other option would be to copy_list the ATTR_IS_DEPENDENT portion of the DECL_ATTRIBUTES list if we need to do this, that would be the same as this patch but replace that *ap = op_attr; at the end with *ap = NULL_TREE; DECL_ATTRIBUTES (cfn) = chainon (copy_list (DECL_ATTRIBUTES (cfn)), op_attr); Or perhaps set ATTR_IS_DEPENDENT on the "operator bindings" attribute, though it would need to be studied what would it try to do with the attribute during tsubst. 2021-06-04 Jakub Jelinek PR c++/100872 * name-lookup.c (maybe_save_operator_binding): Add op_attr after all ATTR_IS_DEPENDENT attributes in the DECL_ATTRIBUTES list rather than to the start. * g++.dg/gomp/declare-simd-8.C: New test. --- gcc/cp/name-lookup.c | 7 +++++-- gcc/testsuite/g++.dg/gomp/declare-simd-8.C | 15 +++++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/g++.dg/gomp/declare-simd-8.C (limited to 'gcc') diff --git a/gcc/cp/name-lookup.c b/gcc/cp/name-lookup.c index a6c9e68..241ad2b 100644 --- a/gcc/cp/name-lookup.c +++ b/gcc/cp/name-lookup.c @@ -9136,9 +9136,12 @@ maybe_save_operator_binding (tree e) tree op_attr = lookup_attribute (op_bind_attrname, attributes); if (!op_attr) { + tree *ap = &DECL_ATTRIBUTES (cfn); + while (*ap && ATTR_IS_DEPENDENT (*ap)) + ap = &TREE_CHAIN (*ap); op_attr = tree_cons (get_identifier (op_bind_attrname), - NULL_TREE, attributes); - DECL_ATTRIBUTES (cfn) = op_attr; + NULL_TREE, *ap); + *ap = op_attr; } tree op_bind = purpose_member (fnname, TREE_VALUE (op_attr)); diff --git a/gcc/testsuite/g++.dg/gomp/declare-simd-8.C b/gcc/testsuite/g++.dg/gomp/declare-simd-8.C new file mode 100644 index 0000000..01c91e8 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/declare-simd-8.C @@ -0,0 +1,15 @@ +// PR c++/100872 + +template +struct S { + #pragma omp declare simd aligned(a : N * 2) aligned(b) linear(ref(b): N) + float foo (float *a, T *&b) { return *a + *b; } +}; + +S<16, float> s; + +float +bar (float *a, float *p) +{ + return s.foo (a, p); +} -- cgit v1.1 From b7dd2e4eeb44bc8678ecde8a6c7401de85e63561 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 4 Jun 2021 11:20:02 +0200 Subject: x86: Fix ix86_expand_vector_init for V*TImode [PR100887] We have vec_initv4tiv2ti and vec_initv2titi patterns which call ix86_expand_vector_init and assume it works for those modes. For the case of construction from two half-sized vectors, the code assumes it will always succeed, but we have only insn patterns with SImode and DImode element types. QImode and HImode element types are already handled by performing it with same sized vectors with SImode elements and the following patch extends that to V*TImode vectors. 2021-06-04 Jakub Jelinek PR target/100887 * config/i386/i386-expand.c (ix86_expand_vector_init): Handle concatenation from half-sized modes with TImode elements. * gcc.target/i386/pr100887.c: New test. --- gcc/config/i386/i386-expand.c | 10 +++++++--- gcc/testsuite/gcc.target/i386/pr100887.c | 13 +++++++++++++ 2 files changed, 20 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gcc.target/i386/pr100887.c (limited to 'gcc') diff --git a/gcc/config/i386/i386-expand.c b/gcc/config/i386/i386-expand.c index eb7cdb0..68bb5ab 100644 --- a/gcc/config/i386/i386-expand.c +++ b/gcc/config/i386/i386-expand.c @@ -14610,11 +14610,15 @@ ix86_expand_vector_init (bool mmx_ok, rtx target, rtx vals) if (GET_MODE_NUNITS (GET_MODE (x)) * 2 == n_elts) { rtx ops[2] = { XVECEXP (vals, 0, 0), XVECEXP (vals, 0, 1) }; - if (inner_mode == QImode || inner_mode == HImode) + if (inner_mode == QImode + || inner_mode == HImode + || inner_mode == TImode) { unsigned int n_bits = n_elts * GET_MODE_SIZE (inner_mode); - mode = mode_for_vector (SImode, n_bits / 4).require (); - inner_mode = mode_for_vector (SImode, n_bits / 8).require (); + scalar_mode elt_mode = inner_mode == TImode ? DImode : SImode; + n_bits /= GET_MODE_SIZE (elt_mode); + mode = mode_for_vector (elt_mode, n_bits).require (); + inner_mode = mode_for_vector (elt_mode, n_bits / 2).require (); ops[0] = gen_lowpart (inner_mode, ops[0]); ops[1] = gen_lowpart (inner_mode, ops[1]); subtarget = gen_reg_rtx (mode); diff --git a/gcc/testsuite/gcc.target/i386/pr100887.c b/gcc/testsuite/gcc.target/i386/pr100887.c new file mode 100644 index 0000000..1bc6d38 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr100887.c @@ -0,0 +1,13 @@ +/* PR target/100887 */ +/* { dg-do compile { target int128 } } */ +/* { dg-options "-mavx512f" } */ + +typedef unsigned __int128 U __attribute__((__vector_size__ (64))); +typedef unsigned __int128 V __attribute__((__vector_size__ (32))); +typedef unsigned __int128 W __attribute__((__vector_size__ (16))); + +W +foo (U u, V v) +{ + return __builtin_shufflevector (u, v, 0); +} -- 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/dump-parse-tree.c | 23 +++ gcc/fortran/frontend-passes.c | 5 + gcc/fortran/gfortran.h | 18 +- gcc/fortran/match.h | 5 + gcc/fortran/openmp.c | 94 +++++++++- gcc/fortran/parse.c | 104 ++++++----- gcc/fortran/resolve.c | 10 + gcc/fortran/st.c | 5 + gcc/fortran/trans-openmp.c | 117 ++++++++++-- gcc/fortran/trans.c | 5 + gcc/testsuite/gfortran.dg/goacc/omp-fixed.f | 2 +- gcc/testsuite/gfortran.dg/goacc/omp.f95 | 2 +- gcc/testsuite/gfortran.dg/gomp/loop-1.f90 | 56 ++++++ gcc/testsuite/gfortran.dg/gomp/loop-2.f90 | 44 +++++ gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 | 238 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 | 34 ++++ gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 | 231 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/pr99928-3.f90 | 30 +-- gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 | 89 +++++++++ gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 | 107 +++++++++++ gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 | 107 +++++++++++ gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 | 252 ++++++++++++++++++++++++++ 22 files changed, 1497 insertions(+), 81 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/loop-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/loop-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 (limited to 'gcc') diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 0e7fe1c..8e2df73 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1718,6 +1718,19 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fprintf (dumpfile, " PROC_BIND(%s)", type); } + if (omp_clauses->bind != OMP_BIND_UNSET) + { + const char *type; + switch (omp_clauses->bind) + { + case OMP_BIND_TEAMS: type = "TEAMS"; break; + case OMP_BIND_PARALLEL: type = "PARALLEL"; break; + case OMP_BIND_THREAD: type = "THREAD"; break; + default: + gcc_unreachable (); + } + fprintf (dumpfile, " BIND(%s)", type); + } if (omp_clauses->num_teams) { fputs (" NUM_TEAMS(", dumpfile); @@ -1896,6 +1909,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break; case EXEC_OMP_DO: name = "DO"; break; case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; + case EXEC_OMP_LOOP: name = "LOOP"; break; case EXEC_OMP_FLUSH: name = "FLUSH"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break; @@ -1905,6 +1919,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break; case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; + case EXEC_OMP_PARALLEL_LOOP: name = "PARALLEL LOOP"; break; case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: name = "PARALLEL MASTER TASKLOOP"; break; @@ -1924,6 +1939,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break; case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: name = "TARGET_PARALLEL_DO_SIMD"; break; + case EXEC_OMP_TARGET_PARALLEL_LOOP: name = "TARGET PARALLEL LOOP"; break; case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break; case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: @@ -1934,6 +1950,7 @@ show_omp_node (int level, gfc_code *c) name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: name = "TARGET TEAMS DISTRIBUTE SIMD"; break; + case EXEC_OMP_TARGET_TEAMS_LOOP: name = "TARGET TEAMS LOOP"; break; case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break; case EXEC_OMP_TASK: name = "TASK"; break; case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; @@ -1948,6 +1965,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break; + case EXEC_OMP_TEAMS_LOOP: name = "TEAMS LOOP"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; default: gcc_unreachable (); @@ -1977,10 +1995,12 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_ORDERED: 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: @@ -1997,12 +2017,14 @@ show_omp_node (int level, gfc_code *c) 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_TASKLOOP: @@ -2012,6 +2034,7 @@ show_omp_node (int level, gfc_code *c) 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: omp_clauses = c->ext.omp_clauses; break; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index e3b1d15..34fb22c 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -5542,6 +5542,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, 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: @@ -5567,6 +5568,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: @@ -5581,12 +5583,14 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, 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_TEAMS: @@ -5594,6 +5598,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, 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: /* Come to this label only from the EXEC_OMP_PARALLEL_* cases above. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2020ab4..cbc95d3 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -271,7 +271,11 @@ enum gfc_statement ST_OMP_END_PARALLEL_MASTER_TASKLOOP, ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD, ST_OMP_MASTER_TASKLOOP, ST_OMP_END_MASTER_TASKLOOP, ST_OMP_MASTER_TASKLOOP_SIMD, - ST_OMP_END_MASTER_TASKLOOP_SIMD, ST_NONE + ST_OMP_END_MASTER_TASKLOOP_SIMD, ST_OMP_LOOP, ST_OMP_END_LOOP, + ST_OMP_PARALLEL_LOOP, ST_OMP_END_PARALLEL_LOOP, ST_OMP_TEAMS_LOOP, + ST_OMP_END_TEAMS_LOOP, ST_OMP_TARGET_PARALLEL_LOOP, + ST_OMP_END_TARGET_PARALLEL_LOOP, ST_OMP_TARGET_TEAMS_LOOP, + ST_OMP_END_TARGET_TEAMS_LOOP, ST_NONE }; /* Types of interfaces that we can have. Assignment interfaces are @@ -1401,6 +1405,14 @@ enum gfc_omp_memorder OMP_MEMORDER_RELAXED }; +enum gfc_omp_bind_type +{ + OMP_BIND_UNSET, + OMP_BIND_TEAMS, + OMP_BIND_PARALLEL, + OMP_BIND_THREAD +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; @@ -1421,6 +1433,7 @@ typedef struct gfc_omp_clauses enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; enum gfc_omp_depend_op depobj_update; + enum gfc_omp_bind_type bind; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; struct gfc_expr *num_teams; @@ -2717,7 +2730,8 @@ enum gfc_exec_op EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ, EXEC_OMP_PARALLEL_MASTER, EXEC_OMP_PARALLEL_MASTER_TASKLOOP, EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, EXEC_OMP_MASTER_TASKLOOP, - EXEC_OMP_MASTER_TASKLOOP_SIMD + EXEC_OMP_MASTER_TASKLOOP_SIMD, EXEC_OMP_LOOP, EXEC_OMP_PARALLEL_LOOP, + EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP, EXEC_OMP_TARGET_TEAMS_LOOP }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index bcedf8e..bb1f34f 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -167,6 +167,7 @@ match gfc_match_omp_distribute_parallel_do_simd (void); match gfc_match_omp_distribute_simd (void); match gfc_match_omp_do (void); match gfc_match_omp_do_simd (void); +match gfc_match_omp_loop (void); match gfc_match_omp_flush (void); match gfc_match_omp_master (void); match gfc_match_omp_master_taskloop (void); @@ -176,6 +177,7 @@ match gfc_match_omp_ordered_depend (void); match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); match gfc_match_omp_parallel_do_simd (void); +match gfc_match_omp_parallel_loop (void); match gfc_match_omp_parallel_master (void); match gfc_match_omp_parallel_master_taskloop (void); match gfc_match_omp_parallel_master_taskloop_simd (void); @@ -193,12 +195,14 @@ match gfc_match_omp_target_exit_data (void); match gfc_match_omp_target_parallel (void); match gfc_match_omp_target_parallel_do (void); match gfc_match_omp_target_parallel_do_simd (void); +match gfc_match_omp_target_parallel_loop (void); match gfc_match_omp_target_simd (void); match gfc_match_omp_target_teams (void); match gfc_match_omp_target_teams_distribute (void); match gfc_match_omp_target_teams_distribute_parallel_do (void); match gfc_match_omp_target_teams_distribute_parallel_do_simd (void); match gfc_match_omp_target_teams_distribute_simd (void); +match gfc_match_omp_target_teams_loop (void); match gfc_match_omp_target_update (void); match gfc_match_omp_task (void); match gfc_match_omp_taskgroup (void); @@ -211,6 +215,7 @@ match gfc_match_omp_teams_distribute (void); match gfc_match_omp_teams_distribute_parallel_do (void); match gfc_match_omp_teams_distribute_parallel_do_simd (void); match gfc_match_omp_teams_distribute_simd (void); +match gfc_match_omp_teams_loop (void); match gfc_match_omp_threadprivate (void); match gfc_match_omp_workshare (void); match gfc_match_omp_end_critical (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 9dba165..d7136b1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -846,6 +846,7 @@ enum omp_mask1 OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_BIND, /* OpenMP 5.0. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -1426,6 +1427,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; break; + case 'b': + if ((mask & OMP_CLAUSE_BIND) + && c->bind == OMP_BIND_UNSET + && gfc_match ("bind ( ") == MATCH_YES) + { + if (gfc_match ("teams )") == MATCH_YES) + c->bind = OMP_BIND_TEAMS; + else if (gfc_match ("parallel )") == MATCH_YES) + c->bind = OMP_BIND_PARALLEL; + else if (gfc_match ("thread )") == MATCH_YES) + c->bind = OMP_BIND_THREAD; + else + { + gfc_error ("Expected TEAMS, PARALLEL or THEAD as binding in " + "BIND at %C"); + break; + } + continue; + } + break; case 'c': if ((mask & OMP_CLAUSE_CAPTURE) && !c->capture @@ -3016,6 +3037,9 @@ cleanup: | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) +#define OMP_LOOP_CLAUSES \ + (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) @@ -3255,6 +3279,45 @@ gfc_match_omp_do_simd (void) match +gfc_match_omp_loop (void) +{ + return match_omp (EXEC_OMP_LOOP, OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_teams_loop (void) +{ + return match_omp (EXEC_OMP_TEAMS_LOOP, OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_target_teams_loop (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_LOOP, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_parallel_loop (void) +{ + return match_omp (EXEC_OMP_PARALLEL_LOOP, + OMP_PARALLEL_CLAUSES | OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_target_parallel_loop (void) +{ + return match_omp (EXEC_OMP_TARGET_PARALLEL_LOOP, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_LOOP_CLAUSES)); +} + + +match gfc_match_omp_flush (void) { gfc_omp_namelist *list = NULL; @@ -5889,14 +5952,19 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, { case OMP_LIST_REDUCTION_TASK: if (code - && (code->op == EXEC_OMP_TASKLOOP + && (code->op == EXEC_OMP_LOOP + || code->op == EXEC_OMP_TASKLOOP || code->op == EXEC_OMP_TASKLOOP_SIMD || code->op == EXEC_OMP_MASTER_TASKLOOP || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD + || code->op == EXEC_OMP_PARALLEL_LOOP || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD + || code->op == EXEC_OMP_TARGET_PARALLEL_LOOP + || code->op == EXEC_OMP_TARGET_TEAMS_LOOP || code->op == EXEC_OMP_TEAMS - || code->op == EXEC_OMP_TEAMS_DISTRIBUTE)) + || code->op == EXEC_OMP_TEAMS_DISTRIBUTE + || code->op == EXEC_OMP_TEAMS_LOOP)) { gfc_error ("Only DEFAULT permitted as reduction-" "modifier in REDUCTION clause at %L", @@ -6953,11 +7021,13 @@ resolve_omp_do (gfc_code *code) break; case EXEC_OMP_DO: name = "!$OMP DO"; break; case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break; + case EXEC_OMP_LOOP: name = "!$OMP LOOP"; break; case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break; case EXEC_OMP_PARALLEL_DO_SIMD: name = "!$OMP PARALLEL DO SIMD"; is_simd = true; break; + case EXEC_OMP_PARALLEL_LOOP: name = "!$OMP PARALLEL LOOP"; break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: name = "!$OMP PARALLEL MASTER TASKLOOP"; break; @@ -6976,6 +7046,9 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TARGET PARALLEL DO SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_PARALLEL_LOOP: + name = "!$OMP TARGET PARALLEL LOOP"; + break; case EXEC_OMP_TARGET_SIMD: name = "!$OMP TARGET SIMD"; is_simd = true; @@ -6994,6 +7067,7 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_TEAMS_LOOP: name = "!$OMP TARGET TEAMS LOOP"; break; case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break; case EXEC_OMP_TASKLOOP_SIMD: name = "!$OMP TASKLOOP SIMD"; @@ -7011,6 +7085,7 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TEAMS DISTRIBUTE SIMD"; is_simd = true; break; + case EXEC_OMP_TEAMS_LOOP: name = "!$OMP TEAMS LOOP"; break; default: gcc_unreachable (); } @@ -7152,6 +7227,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_PARALLEL_WORKSHARE; case EXEC_OMP_DO: return ST_OMP_DO; + case EXEC_OMP_LOOP: + return ST_OMP_LOOP; case EXEC_OMP_ATOMIC: return ST_OMP_ATOMIC; case EXEC_OMP_BARRIER: @@ -7190,6 +7267,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_TARGET_PARALLEL_DO; case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: return ST_OMP_TARGET_PARALLEL_DO_SIMD; + case EXEC_OMP_TARGET_PARALLEL_LOOP: + return ST_OMP_TARGET_PARALLEL_LOOP; case EXEC_OMP_TARGET_SIMD: return ST_OMP_TARGET_SIMD; case EXEC_OMP_TARGET_TEAMS: @@ -7202,6 +7281,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: return ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD; + case EXEC_OMP_TARGET_TEAMS_LOOP: + return ST_OMP_TARGET_TEAMS_LOOP; case EXEC_OMP_TARGET_UPDATE: return ST_OMP_TARGET_UPDATE; case EXEC_OMP_TASKGROUP: @@ -7224,10 +7305,14 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: return ST_OMP_TEAMS_DISTRIBUTE_SIMD; + case EXEC_OMP_TEAMS_LOOP: + return ST_OMP_TEAMS_LOOP; case EXEC_OMP_PARALLEL_DO: return ST_OMP_PARALLEL_DO; case EXEC_OMP_PARALLEL_DO_SIMD: return ST_OMP_PARALLEL_DO_SIMD; + case EXEC_OMP_PARALLEL_LOOP: + return ST_OMP_PARALLEL_LOOP; case EXEC_OMP_DEPOBJ: return ST_OMP_DEPOBJ; default: @@ -7628,8 +7713,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_LOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: @@ -7637,17 +7724,20 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_SIMD: 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_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_TASKLOOP: case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE: 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: resolve_omp_do (code); break; case EXEC_OMP_CANCEL: diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c44e23c..0522b39 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -988,6 +988,9 @@ decode_omp_directive (void) ST_OMP_MASTER_TASKLOOP); matcho ("master", gfc_match_omp_master, ST_OMP_MASTER); break; + case 'l': + matcho ("loop", gfc_match_omp_loop, ST_OMP_LOOP); + break; case 'o': if (gfc_match ("ordered depend (") == MATCH_YES) { @@ -1004,6 +1007,8 @@ decode_omp_directive (void) matchs ("parallel do simd", gfc_match_omp_parallel_do_simd, ST_OMP_PARALLEL_DO_SIMD); matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO); + matcho ("parallel loop", gfc_match_omp_parallel_loop, + ST_OMP_PARALLEL_LOOP); matcho ("parallel master taskloop simd", gfc_match_omp_parallel_master_taskloop_simd, ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD); @@ -1037,6 +1042,8 @@ decode_omp_directive (void) ST_OMP_TARGET_PARALLEL_DO_SIMD); matcho ("target parallel do", gfc_match_omp_target_parallel_do, ST_OMP_TARGET_PARALLEL_DO); + matcho ("target parallel loop", gfc_match_omp_target_parallel_loop, + ST_OMP_TARGET_PARALLEL_LOOP); matcho ("target parallel", gfc_match_omp_target_parallel, ST_OMP_TARGET_PARALLEL); matchs ("target simd", gfc_match_omp_target_simd, ST_OMP_TARGET_SIMD); @@ -1051,6 +1058,8 @@ decode_omp_directive (void) ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD); matcho ("target teams distribute", gfc_match_omp_target_teams_distribute, ST_OMP_TARGET_TEAMS_DISTRIBUTE); + matcho ("target teams loop", gfc_match_omp_target_teams_loop, + ST_OMP_TARGET_TEAMS_LOOP); matcho ("target teams", gfc_match_omp_target_teams, ST_OMP_TARGET_TEAMS); matcho ("target update", gfc_match_omp_target_update, ST_OMP_TARGET_UPDATE); @@ -1072,6 +1081,7 @@ decode_omp_directive (void) ST_OMP_TEAMS_DISTRIBUTE_SIMD); matcho ("teams distribute", gfc_match_omp_teams_distribute, ST_OMP_TEAMS_DISTRIBUTE); + matcho ("teams loop", gfc_match_omp_teams_loop, ST_OMP_TEAMS_LOOP); matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS); matchdo ("threadprivate", gfc_match_omp_threadprivate, ST_OMP_THREADPRIVATE); @@ -1125,9 +1135,11 @@ decode_omp_directive (void) case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_TEAMS_LOOP: case ST_OMP_TARGET_PARALLEL: case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_SIMD: case ST_OMP_TARGET_UPDATE: { @@ -1650,6 +1662,8 @@ next_statement (void) case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL: \ case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \ case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \ + case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \ + case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \ case ST_CRITICAL: \ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ @@ -2359,6 +2373,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_SIMD: p = "!$OMP END SIMD"; break; + case ST_OMP_END_LOOP: + p = "!$OMP END LOOP"; + break; case ST_OMP_END_MASTER: p = "!$OMP END MASTER"; break; @@ -2380,6 +2397,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_PARALLEL_DO_SIMD: p = "!$OMP END PARALLEL DO SIMD"; break; + case ST_OMP_END_PARALLEL_LOOP: + p = "!$OMP END PARALLEL LOOP"; + break; case ST_OMP_END_PARALLEL_MASTER: p = "!$OMP END PARALLEL MASTER"; break; @@ -2419,6 +2439,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TARGET_PARALLEL_DO_SIMD: p = "!$OMP END TARGET PARALLEL DO SIMD"; break; + case ST_OMP_END_TARGET_PARALLEL_LOOP: + p = "!$OMP END TARGET PARALLEL LOOP"; + break; case ST_OMP_END_TARGET_SIMD: p = "!$OMP END TARGET SIMD"; break; @@ -2437,6 +2460,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD: p = "!$OMP END TARGET TEAMS DISTRIBUTE SIMD"; break; + case ST_OMP_END_TARGET_TEAMS_LOOP: + p = "!$OMP END TARGET TEAMS LOOP"; + break; case ST_OMP_END_TASKGROUP: p = "!$OMP END TASKGROUP"; break; @@ -2461,12 +2487,18 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TEAMS_DISTRIBUTE_SIMD: p = "!$OMP END TEAMS DISTRIBUTE SIMD"; break; + case ST_OMP_END_TEAMS_LOOP: + p = "!$OMP END TEAMS LOP"; + break; case ST_OMP_END_WORKSHARE: p = "!$OMP END WORKSHARE"; break; case ST_OMP_FLUSH: p = "!$OMP FLUSH"; break; + case ST_OMP_LOOP: + p = "!$OMP LOOP"; + break; case ST_OMP_MASTER: p = "!$OMP MASTER"; break; @@ -2486,6 +2518,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_PARALLEL_DO: p = "!$OMP PARALLEL DO"; break; + case ST_OMP_PARALLEL_LOOP: + p = "!$OMP PARALLEL LOOP"; + break; case ST_OMP_PARALLEL_DO_SIMD: p = "!$OMP PARALLEL DO SIMD"; break; @@ -2543,6 +2578,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TARGET_PARALLEL_DO_SIMD: p = "!$OMP TARGET PARALLEL DO SIMD"; break; + case ST_OMP_TARGET_PARALLEL_LOOP: + p = "!$OMP TARGET PARALLEL LOOP"; + break; case ST_OMP_TARGET_SIMD: p = "!$OMP TARGET SIMD"; break; @@ -2561,6 +2599,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: p = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; break; + case ST_OMP_TARGET_TEAMS_LOOP: + p = "!$OMP TARGET TEAMS LOOP"; + break; case ST_OMP_TARGET_UPDATE: p = "!$OMP TARGET UPDATE"; break; @@ -2597,6 +2638,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TEAMS_DISTRIBUTE_SIMD: p = "!$OMP TEAMS DISTRIBUTE SIMD"; break; + case ST_OMP_TEAMS_LOOP: + p = "!$OMP TEAMS LOOP"; + break; case ST_OMP_THREADPRIVATE: p = "!$OMP THREADPRIVATE"; break; @@ -5044,10 +5088,14 @@ parse_omp_do (gfc_statement omp_st) break; case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break; case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break; + case ST_OMP_LOOP: omp_end_st = ST_OMP_END_LOOP; break; case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break; case ST_OMP_PARALLEL_DO_SIMD: omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD; break; + case ST_OMP_PARALLEL_LOOP: + omp_end_st = ST_OMP_END_PARALLEL_LOOP; + break; case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break; case ST_OMP_TARGET_PARALLEL_DO: omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO; @@ -5055,6 +5103,9 @@ parse_omp_do (gfc_statement omp_st) case ST_OMP_TARGET_PARALLEL_DO_SIMD: omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD; break; + case ST_OMP_TARGET_PARALLEL_LOOP: + omp_end_st = ST_OMP_END_TARGET_PARALLEL_LOOP; + break; case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break; case ST_OMP_TARGET_TEAMS_DISTRIBUTE: omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; @@ -5068,6 +5119,9 @@ parse_omp_do (gfc_statement omp_st) case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; break; + case ST_OMP_TARGET_TEAMS_LOOP: + omp_end_st = ST_OMP_END_TARGET_TEAMS_LOOP; + break; case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break; case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break; case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break; @@ -5092,6 +5146,9 @@ parse_omp_do (gfc_statement omp_st) case ST_OMP_TEAMS_DISTRIBUTE_SIMD: omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD; break; + case ST_OMP_TEAMS_LOOP: + omp_end_st = ST_OMP_END_TEAMS_LOOP; + break; default: gcc_unreachable (); } if (st == omp_end_st) @@ -5323,12 +5380,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_PARALLEL_MASTER: omp_end_st = ST_OMP_END_PARALLEL_MASTER; break; - case ST_OMP_PARALLEL_MASTER_TASKLOOP: - omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP; - break; - case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: - omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD; - break; case ST_OMP_PARALLEL_SECTIONS: omp_end_st = ST_OMP_END_PARALLEL_SECTIONS; break; @@ -5344,12 +5395,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_MASTER: omp_end_st = ST_OMP_END_MASTER; break; - case ST_OMP_MASTER_TASKLOOP: - omp_end_st = ST_OMP_END_MASTER_TASKLOOP; - break; - case ST_OMP_MASTER_TASKLOOP_SIMD: - omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD; - break; case ST_OMP_SINGLE: omp_end_st = ST_OMP_END_SINGLE; break; @@ -5365,18 +5410,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_TARGET_TEAMS: omp_end_st = ST_OMP_END_TARGET_TEAMS; break; - case ST_OMP_TARGET_TEAMS_DISTRIBUTE: - omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; - break; - case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: - omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO; - break; - case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: - omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; - break; - case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: - omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; - break; case ST_OMP_TASK: omp_end_st = ST_OMP_END_TASK; break; @@ -5389,27 +5422,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_TEAMS_DISTRIBUTE: omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; break; - case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: - omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO; - break; - case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: - omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; - break; - case ST_OMP_TEAMS_DISTRIBUTE_SIMD: - omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD; - break; case ST_OMP_DISTRIBUTE: omp_end_st = ST_OMP_END_DISTRIBUTE; break; - case ST_OMP_DISTRIBUTE_PARALLEL_DO: - omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; - break; - case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: - omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD; - break; - case ST_OMP_DISTRIBUTE_SIMD: - omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD; - break; case ST_OMP_WORKSHARE: omp_end_st = ST_OMP_END_WORKSHARE; break; @@ -5689,8 +5704,10 @@ parse_executable (gfc_statement st) case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DO: case ST_OMP_DO_SIMD: + case ST_OMP_LOOP: case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: + case ST_OMP_PARALLEL_LOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case ST_OMP_MASTER_TASKLOOP: @@ -5698,17 +5715,20 @@ parse_executable (gfc_statement st) case ST_OMP_SIMD: case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TARGET_TEAMS_LOOP: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TEAMS_LOOP: st = parse_omp_do (st); if (st == ST_IMPLIED_ENDDO) return st; 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: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 9f6fe49..6ae1df6 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -225,6 +225,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_END_SINGLE: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -232,6 +233,7 @@ gfc_free_statement (gfc_code *p) 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: @@ -248,12 +250,14 @@ gfc_free_statement (gfc_code *p) 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_TASKLOOP: @@ -263,6 +267,7 @@ gfc_free_statement (gfc_code *p) 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_free_omp_clauses (p->ext.omp_clauses); break; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 2917d3d..1e22cdb 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4195,6 +4195,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg; } } + if (clauses->bind != OMP_BIND_UNSET) + { + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_BIND); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + switch (clauses->bind) + { + case OMP_BIND_TEAMS: + OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_TEAMS; + break; + case OMP_BIND_PARALLEL: + OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_PARALLEL; + break; + case OMP_BIND_THREAD: + OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_THREAD; + break; + default: + gcc_unreachable (); + } + } return nreverse (omp_clauses); } @@ -5083,6 +5102,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + case EXEC_OMP_LOOP: stmt = make_node (OMP_LOOP); break; case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break; case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break; default: gcc_unreachable (); @@ -5343,6 +5363,7 @@ gfc_split_omp_clauses (gfc_code *code, gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) { int mask = 0, innermost = 0; + bool is_loop = false; memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses)); switch (code->op) { @@ -5363,6 +5384,7 @@ gfc_split_omp_clauses (gfc_code *code, innermost = GFC_OMP_SPLIT_SIMD; break; case EXEC_OMP_DO: + case EXEC_OMP_LOOP: innermost = GFC_OMP_SPLIT_DO; break; case EXEC_OMP_DO_SIMD: @@ -5373,6 +5395,7 @@ gfc_split_omp_clauses (gfc_code *code, innermost = GFC_OMP_SPLIT_PARALLEL; break; case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_LOOP: mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; innermost = GFC_OMP_SPLIT_DO; break; @@ -5399,6 +5422,7 @@ gfc_split_omp_clauses (gfc_code *code, innermost = GFC_OMP_SPLIT_PARALLEL; break; case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_LOOP: mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; innermost = GFC_OMP_SPLIT_DO; break; @@ -5435,6 +5459,10 @@ gfc_split_omp_clauses (gfc_code *code, | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TARGET_TEAMS_LOOP: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_TASKLOOP: innermost = GFC_OMP_SPLIT_TASKLOOP; @@ -5465,6 +5493,10 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TEAMS_LOOP: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; default: gcc_unreachable (); } @@ -5473,6 +5505,18 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[innermost] = *code->ext.omp_clauses; return; } + /* Loops are similar to DO but still a bit different. */ + switch (code->op) + { + case EXEC_OMP_LOOP: + case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_TEAMS_LOOP: + case EXEC_OMP_TARGET_PARALLEL_LOOP: + case EXEC_OMP_TARGET_TEAMS_LOOP: + is_loop = true; + default: + break; + } if (code->ext.omp_clauses != NULL) { if (mask & GFC_OMP_MASK_TARGET) @@ -5540,7 +5584,7 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr = code->ext.omp_clauses->if_expr; } - if (mask & GFC_OMP_MASK_DO) + if ((mask & GFC_OMP_MASK_DO) && !is_loop) { /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_DO].ordered @@ -5560,6 +5604,11 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->chunk_size; clausesa[GFC_OMP_SPLIT_DO].nowait = code->ext.omp_clauses->nowait; + } + if (mask & GFC_OMP_MASK_DO) + { + clausesa[GFC_OMP_SPLIT_DO].bind + = code->ext.omp_clauses->bind; /* Duplicate collapse. */ clausesa[GFC_OMP_SPLIT_DO].collapse = code->ext.omp_clauses->collapse; @@ -5621,7 +5670,7 @@ gfc_split_omp_clauses (gfc_code *code, it is enough to put it on the innermost one. For !$ omp parallel do put it on parallel though, as that's what we did for OpenMP 3.1. */ - clausesa[innermost == GFC_OMP_SPLIT_DO + clausesa[innermost == GFC_OMP_SPLIT_DO && !is_loop ? (int) GFC_OMP_SPLIT_PARALLEL : innermost].lists[OMP_LIST_PRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; @@ -5637,19 +5686,25 @@ gfc_split_omp_clauses (gfc_code *code, else if (mask & GFC_OMP_MASK_DISTRIBUTE) clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + if (mask & GFC_OMP_MASK_TASKLOOP) + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; if (mask & GFC_OMP_MASK_PARALLEL) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; - else if (mask & GFC_OMP_MASK_DO) + else if ((mask & GFC_OMP_MASK_DO) && !is_loop) clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; - /* Lastprivate is allowed on distribute, do and simd. + /* Lastprivate is allowed on distribute, do, simd, taskloop and loop. In parallel do{, simd} we actually want to put it on parallel rather than do. */ if (mask & GFC_OMP_MASK_DISTRIBUTE) clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; - if (mask & GFC_OMP_MASK_PARALLEL) + if (mask & GFC_OMP_MASK_TASKLOOP) + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; else if (mask & GFC_OMP_MASK_DO) @@ -5658,17 +5713,25 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_SIMD) clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; - /* Reduction is allowed on simd, do, parallel and teams. - Duplicate it on all of them, but omit on do if - parallel is present; additionally, inscan applies to do/simd only. */ + /* Reduction is allowed on simd, do, parallel, teams, taskloop, and loop. + Duplicate it on all of them, but + - omit on do if parallel is present; + - omit on task and parallel if loop is present; + additionally, inscan applies to do/simd only. */ for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++) { - if (mask & GFC_OMP_MASK_TEAMS + if (mask & GFC_OMP_MASK_TASKLOOP && i != OMP_LIST_REDUCTION_INSCAN) + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[i] + = code->ext.omp_clauses->lists[i]; + if (mask & GFC_OMP_MASK_TEAMS + && i != OMP_LIST_REDUCTION_INSCAN + && !is_loop) clausesa[GFC_OMP_SPLIT_TEAMS].lists[i] = code->ext.omp_clauses->lists[i]; if (mask & GFC_OMP_MASK_PARALLEL - && i != OMP_LIST_REDUCTION_INSCAN) + && i != OMP_LIST_REDUCTION_INSCAN + && !is_loop) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] = code->ext.omp_clauses->lists[i]; else if (mask & GFC_OMP_MASK_DO) @@ -5689,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[innermost].lists[OMP_LIST_LINEAR] = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; } - if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) - == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + && !is_loop) clausesa[GFC_OMP_SPLIT_DO].nowait = true; } @@ -5740,7 +5804,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, } static tree -gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock, +gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock, gfc_omp_clauses *clausesa) { stmtblock_t block, *new_pblock = pblock; @@ -5768,8 +5832,9 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock, else pushlevel (); } - stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock, - &clausesa[GFC_OMP_SPLIT_DO], omp_clauses); + stmt = gfc_trans_omp_do (code, is_loop ? EXEC_OMP_LOOP : EXEC_OMP_DO, + new_pblock, &clausesa[GFC_OMP_SPLIT_DO], + omp_clauses); if (pblock == NULL) { if (TREE_CODE (stmt) != BIND_EXPR) @@ -6006,7 +6071,7 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: - stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + stmt = gfc_trans_omp_parallel_do (code, false, &block, clausesa); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -6083,6 +6148,12 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE], NULL); break; + case EXEC_OMP_TARGET_TEAMS_LOOP: + case EXEC_OMP_TEAMS_LOOP: + stmt = gfc_trans_omp_do (code, EXEC_OMP_LOOP, NULL, + &clausesa[GFC_OMP_SPLIT_DO], + NULL); + break; default: stmt = gfc_trans_omp_distribute (code, clausesa); break; @@ -6140,7 +6211,11 @@ gfc_trans_omp_target (gfc_code *code) } break; case EXEC_OMP_TARGET_PARALLEL_DO: - stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + case EXEC_OMP_TARGET_PARALLEL_LOOP: + stmt = gfc_trans_omp_parallel_do (code, + (code->op + == EXEC_OMP_TARGET_PARALLEL_LOOP), + &block, clausesa); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -6611,6 +6686,7 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_depobj (code); case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: + case EXEC_OMP_LOOP: case EXEC_OMP_SIMD: case EXEC_OMP_TASKLOOP: return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, @@ -6633,7 +6709,9 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_PARALLEL: return gfc_trans_omp_parallel (code); case EXEC_OMP_PARALLEL_DO: - return gfc_trans_omp_parallel_do (code, NULL, NULL); + return gfc_trans_omp_parallel_do (code, false, NULL, NULL); + case EXEC_OMP_PARALLEL_LOOP: + return gfc_trans_omp_parallel_do (code, true, NULL, NULL); case EXEC_OMP_PARALLEL_DO_SIMD: return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); case EXEC_OMP_PARALLEL_MASTER: @@ -6652,12 +6730,14 @@ gfc_trans_omp_directive (gfc_code *code) 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: return gfc_trans_omp_target (code); case EXEC_OMP_TARGET_DATA: return gfc_trans_omp_target_data (code); @@ -6682,6 +6762,7 @@ gfc_trans_omp_directive (gfc_code *code) 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: return gfc_trans_omp_teams (code, NULL, NULL_TREE); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index cbbfcd9..3ffa394 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2168,6 +2168,7 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: @@ -2176,6 +2177,7 @@ trans_code (gfc_code * code, tree cond) 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: @@ -2191,12 +2193,14 @@ trans_code (gfc_code * code, tree cond) 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: @@ -2209,6 +2213,7 @@ trans_code (gfc_code * code, tree cond) 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: res = gfc_trans_omp_directive (code); break; diff --git a/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f index c6206e7..6ce6f73 100644 --- a/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f +++ b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f @@ -26,7 +26,7 @@ ENDDO !$OMP PARALLEL & -!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" } +!$ACC& KERNELS LOOP ! { dg-error "Wrong OpenMP continuation" } DO I = 1, 10 ENDDO END SUBROUTINE NI diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95 index 339438a..8b3b259 100644 --- a/gcc/testsuite/gfortran.dg/goacc/omp.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/omp.f95 @@ -69,6 +69,6 @@ contains !$omp do ! { dg-error "Wrong OpenACC continuation" } !$omp parallel & - !$acc loop ! { dg-error "Wrong OpenMP continuation" } + !$acc kernels loop ! { dg-error "Wrong OpenMP continuation" } end subroutine nana end module test diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-1.f90 new file mode 100644 index 0000000..c112030 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/loop-1.f90 @@ -0,0 +1,56 @@ +! { dg-additional-options "-fdump-tree-original" } + +implicit none +integer :: q, i, j +integer :: r +r = 0 +!$omp loop bind(thread) reduction(default,+: r) collapse(2) order(concurrent), private(q) lastprivate(i) +do i = 1,4 +do j = 1,4 + r = r + 1 + q = 5 +end do +end do + +!$omp teams loop bind(teams) collapse(2) order(concurrent), private(q) lastprivate(i) reduction(default,+: r) +do i = 1,4 +do j = 1,4 + r = r + 1 + q = 5 +end do +end do + +!$omp target teams loop bind(thread) reduction(+: r) collapse(2) order(concurrent), private(q) lastprivate(i) +do i = 1,4 +do j = 1,4 + r = r + 1 + q = 5 +end do +end do + +!$omp parallel loop bind(thread) collapse(2) order(concurrent), private(q) lastprivate(i) reduction(default,+: r) +do i = 1,4 +do j = 1,4 + r = r + 1 + q = 5 +end do +end do + +!$omp target parallel loop bind(parallel) collapse(2) order(concurrent), private(q) lastprivate(i) reduction(default,+: r) +do i = 1,4 +do j = 1,4 + r = r + 1 + q = 5 +end do +end do + +end + +! TODO: xfailed due to PR99928: +! { dg-final { scan-tree-dump-times "#pragma omp target map\\(tofrom:r\\)\[\r\n\]" 2 "original" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\r\n\]" 2 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams\[\r\n\]" 2 "original" } } + +! { dg-final { scan-tree-dump-times "#pragma omp loop private\\(q\\) lastprivate\\(i\\) reduction\\(\\+:r\\) order\\(concurrent\\) collapse\\(2\\) bind\\(parallel\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp loop private\\(q\\) lastprivate\\(i\\) reduction\\(\\+:r\\) order\\(concurrent\\) collapse\\(2\\) bind\\(teams\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp loop private\\(q\\) lastprivate\\(i\\) reduction\\(\\+:r\\) order\\(concurrent\\) collapse\\(2\\) bind\\(thread\\)" 3 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 new file mode 100644 index 0000000..b2a0d15 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 @@ -0,0 +1,44 @@ +subroutine foo() +implicit none +integer :: i, r +!$omp loop reduction(task, +: r) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +do i = 1, 64 +end do +!$omp teams loop reduction(task, +: r) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +do i = 1, 64 +end do +!$omp parallel loop reduction(task, +: r) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +do i = 1, 64 +end do +!$omp target teams loop reduction(task, +: r) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +do i = 1, 64 +end do +!$omp target parallel loop reduction(task, +: r) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +do i = 1, 64 +end do + +!$omp loop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } +do i = 1, 64 +end do +!$omp teams loop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } +do i = 1, 64 +end do +!$omp parallel loop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } +do i = 1, 64 +end do +!$omp target teams loop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } +do i = 1, 64 +end do +!$omp target parallel loop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } +do i = 1, 64 +end do + +!$omp loop bind(target) ! { dg-error "17: Expected TEAMS, PARALLEL or THEAD as binding in BIND" } +do i = 1, 64 +end do + +!$omp loop bind(teams) bind(teams) ! { dg-error "24: Failed to match clause" } +do i = 1, 64 +end do + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 new file mode 100644 index 0000000..5cbffb0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 @@ -0,0 +1,238 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: f00, f01, f02, f03, f04, f05, f06, f07, f08, f09 + integer :: f12, f13, f14, f15, f16, f17, f18, f19 + integer :: f20, f21, f22, f23, f24, f25, f26, f27, f28, f29 + +contains + +subroutine foo () + integer :: i + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*firstprivate\\(f00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f00\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f00\\)" "gimple" } } ! FIXME. + !$omp distribute parallel do firstprivate (f00) default(none) + do i = 1, 64 + f00 = f00 + 1 + end do + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*firstprivate\\(f01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f01\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f01\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f01\\)" "gimple" } } + !$omp distribute parallel do simd firstprivate (f01) default(none) + do i = 1, 64 + f01 = f01 + 1 + end do + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*firstprivate\\(f02\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f02\\)" "gimple" } } + !$omp distribute simd firstprivate (f02) + do i = 1, 64 + f02 = f02 + 1 + end do +end + +subroutine bar () + integer :: f10, f11 + integer :: i + f10 = 0; f11 = 0 + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*firstprivate\\(f03\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f03\\)" "gimple" } } + !$omp do simd firstprivate (f03) + do i = 1, 64 + f03 = f03 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(f04\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(f04\\)" "gimple" } } + !$omp master taskloop firstprivate (f04) default(none) + do i = 1, 64 + f04 = f04 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(f05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(f05\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f05\\)" "gimple" } } + !$omp master taskloop simd firstprivate (f05) default(none) + do i = 1, 64 + f05 = f05 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f06\\)" "gimple" } } ! FIXME. + !$omp parallel do firstprivate (f06) default(none) + do i = 1, 64 + f06 = f06 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f07\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f07\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f07\\)" "gimple" } } + !$omp parallel do simd firstprivate (f07) default(none) + do i = 1, 64 + f07 = f07 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f08\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f08\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f08\\)" "gimple" } } + !$omp parallel loop firstprivate (f08) default(none) + do i = 1, 64 + f08 = f08 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f09\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(f09\\)" "gimple" } } + !$omp parallel master firstprivate (f09) default(none) + f09 = f09 + 1 + !$omp end parallel master + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(f10\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(f10\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(f10\\)" "gimple" } } + !$omp parallel master taskloop firstprivate (f10) default(none) + do i = 1, 64 + f10 = f10 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(f11\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(f11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(f11\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f11\\)" "gimple" } } + !$omp parallel master taskloop simd firstprivate (f11) default(none) + do i = 1, 64 + f11 = f11 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f12\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp sections\[^\n\r]*firstprivate\\(f12\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp section \[^\n\r]*firstprivate\\(f12\\)" "gimple" } } + !$omp parallel sections firstprivate (f12) default(none) + f12 = f12 + 1 + !$omp section + f12 = f12 + 1 + !$omp end parallel sections + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f13\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f13\\)" "gimple" } } + !$omp target parallel firstprivate (f13) default(none) ! defaultmap(none) + f13 = f13 + 1 + !$omp end target parallel + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f14\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f14\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f14\\)" "gimple" } } ! FIXME. + !$omp target parallel do firstprivate (f14) default(none) ! defaultmap(none) + do i = 1, 64 + f14 = f14 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f15\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f15\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f15\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f15\\)" "gimple" } } + !$omp target parallel do simd firstprivate (f15) default(none) ! defaultmap(none) + do i = 1, 64 + f15 = f15 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f16\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f16\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f16\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f16\\)" "gimple" } } + !$omp target parallel loop firstprivate (f16) default(none) ! defaultmap(none) + do i = 1, 64 + f16 = f16 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f17\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f17\\)" "gimple" } } + !$omp target teams firstprivate (f17) default(none) ! defaultmap(none) + f17 = f17 + 1 + !$omp end target teams + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f18\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f18\\)" "gimple" } } ! FIXME: This should be on distribute instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f18\\)" "gimple" } } ! FIXME. + !$omp target teams distribute firstprivate (f18) default(none) ! defaultmap(none) + do i = 1, 64 + f18 = f18 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f19\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f19\\)" "gimple" } } ! FIXME: This should be on distribute instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f19\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f19\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f19\\)" "gimple" } } ! FIXME. + !$omp target teams distribute parallel do firstprivate (f19) default(none) ! defaultmap(none) + do i = 1, 64 + f19 = f19 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f20\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f20\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f20\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f20\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f20\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f20\\)" "gimple" } } + !$omp target teams distribute parallel do simd firstprivate (f20) default(none) ! defaultmap(none) + do i = 1, 64 + f20 = f20 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f21\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f21\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f21\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f21\\)" "gimple" } } + !$omp target teams distribute simd firstprivate (f21) default(none) ! defaultmap(none) + do i = 1, 64 + f21 = f21 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f22\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f22\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f22\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(f22\\)" "gimple" } } ! NOTE: This is an implementation detail. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f22\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f22\\)" "gimple" } } + !$omp target teams loop firstprivate (f22) default(none) ! defaultmap(none) + do i = 1, 64 + f22 = f22 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*firstprivate\\(f23\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f23\\)" "gimple" } } + !$omp target simd firstprivate (f23) ! defaultmap(none) + do i = 1, 64 + f23 = f23 + 1 + end do + !$omp end target simd + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(f24\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f24\\)" "gimple" } } + !$omp taskloop simd firstprivate (f24) default(none) + do i = 1, 64 + f24 = f24 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f25\\)" "gimple" } } ! FIXME: This should be on distribute instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f25\\)" "gimple" } } ! FIXME. + !$omp teams distribute firstprivate (f25) default(none) + do i = 1, 64 + f25 = f25 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f26\\)" "gimple" } } ! FIXME: This should be on distribute instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f26\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f26\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f26\\)" "gimple" } } ! FIXME. + !$omp teams distribute parallel do firstprivate (f26) default(none) + do i = 1, 64 + f26 = f26 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f27\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f27\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(f27\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f27\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f27\\)" "gimple" } } + !$omp teams distribute parallel do simd firstprivate (f27) default(none) + do i = 1, 64 + f27 = f27 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f28\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f28\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f28\\)" "gimple" } } + !$omp teams distribute simd firstprivate (f28) default(none) + do i = 1, 64 + f28 = f28 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*firstprivate\\(f29\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*firstprivate\\(f29\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(f29\\)" "gimple" } } ! NOTE: This is an implementation detail. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(f29\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(f29\\)" "gimple" } } + !$omp teams loop firstprivate (f29) default(none) + do i = 1, 64 + f29 = f29 + 1 + end do +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 new file mode 100644 index 0000000..864ae4b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 @@ -0,0 +1,34 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: r00, r01, r02 + +contains + +subroutine bar () + integer :: i + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*in_reduction\\(\\+:r00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*in_reduction\\(\\+:r00\\)" "gimple" } } + !$omp master taskloop in_reduction(+:r00) + do i = 1, 64 + r00 = r00 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*in_reduction\\(\\+:r01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*in_reduction\\(\\+:r01\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*in_reduction\\(\\+:r01\\)" "gimple" } } + !$omp master taskloop simd in_reduction(+:r01) + do i = 1, 64 + r01 = r01 + 1 + end do + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*in_reduction\\(\\+:r02\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*in_reduction\\(\\+:r02\\)" "gimple" } } + !$omp taskloop simd in_reduction(+:r02) + do i = 1, 64 + r02 = r02 + 1 + end do + ! FIXME: We don't support in_reduction clause on target yet, once we do, should + ! add testcase coverage for all combined/composite constructs with target as leaf construct. +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 new file mode 100644 index 0000000..5dbf78b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 @@ -0,0 +1,231 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: l00, l01, l02, l03, l04, l05, l06, l07 + integer :: l10, l11, l12, l13, l14, l15, l16, l17, l18 + +contains + +subroutine foo () + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } ! FIXME. + !$omp distribute parallel do lastprivate (l00) default(none) + do i = 1, 64 + l00 = i + end do + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } + !$omp distribute parallel do simd lastprivate (l01) default(none) + do i = 1, 64 + l01 = i + end do + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l02\\)" "gimple" } } + !$omp distribute simd lastprivate (l02) + do i = 1, 64 + l02 = i + end do +end + +subroutine bar () + integer :: j00, j01, j02, j03 + integer :: l08, l09, l19, l20, l21, l22 + integer :: i + l08 = 0; l09 = 0; l19 = 0; l20 = 0; l21 = 0; l22 = 0 + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(l03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l03\\)" "gimple" } } + !$omp do simd lastprivate (l03) + do i = 1, 64 + l03 = i + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l04\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(l04\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l04\\)" "gimple" } } + !$omp master taskloop lastprivate (l04) default(none) + do i = 1, 64 + l04 = i + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(l05\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l05\\)" "gimple" } } + !$omp master taskloop simd lastprivate (l05) default(none) + do i = 1, 64 + l05 = i + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } ! FIXME. + !$omp parallel do lastprivate (l06) default(none) + do i = 1, 64 + l06 = i + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l07\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l07\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l07\\)" "gimple" } } + !$omp parallel do simd lastprivate (l07) default(none) + do i = 1, 64 + l07 = i + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(j00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp parallel loop lastprivate (j00) default(none) + do j00 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(l08\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(l08\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l08\\)" "gimple" } } + !$omp parallel master taskloop lastprivate (l08) default(none) + do i = 1, 64 + l08 = i + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(l09\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(l09\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l09\\)" "gimple" } } + !$omp parallel master taskloop simd lastprivate (l09) default(none) + do i = 1, 64 + l09 = i + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l10\\)" "gimple" } } ! FIXME: This should be on sections instead. + ! { dg-final { scan-tree-dump-not "omp sections\[^\n\r]*lastprivate\\(l10\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp section \[^\n\r]*lastprivate\\(l10\\)" "gimple" } } + !$omp parallel sections lastprivate (l10) default(none) + l10 = 1 + !$omp section + l10 = 2 + !$omp end parallel sections + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l11" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l11\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l11\\)" "gimple" } } ! FIXME. + !$omp target parallel do lastprivate (l11) default(none) ! defaultmap(none) + do i = 1, 64 + l11 = i + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l12" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l12\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l12\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l12\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l12\\)" "gimple" } } + !$omp target parallel do simd lastprivate (l12) default(none) ! defaultmap(none) + do i = 1, 64 + l12 = i + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j01" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(j01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(j01\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(j01\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp target parallel loop lastprivate (j01) default(none) ! defaultmap(none) + do j01 = 0, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l13" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l13\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l13\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l13\\)" "gimple" } } + !$omp target teams distribute lastprivate (l13) default(none) ! defaultmap(none) + do i = 1, 64 + l13 = i + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l14" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l14\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l14\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l14\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l14\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l14\\)" "gimple" } } ! FIXME. + !$omp target teams distribute parallel do lastprivate (l14) default(none) ! defaultmap(none) + do i = 1, 64 + l14 = i + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l15" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l15\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l15\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l15\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l15\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l15\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l15\\)" "gimple" } } + !$omp target teams distribute parallel do simd lastprivate (l15) default(none) ! defaultmap(none) + do i = 1, 64 + l15 = i + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l16" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l16\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l16\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l16\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l16\\)" "gimple" } } + !$omp target teams distribute simd lastprivate (l16) default(none) ! defaultmap(none) + do i = 1, 64 + l16 = i + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j02" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j02\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(j02\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(j02\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(j02\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp target teams loop lastprivate (j02) default(none) ! defaultmap(none) + do j02 = 0, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l17" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l17\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l17\\)" "gimple" } } + !$omp target simd lastprivate (l17) ! defaultmap(none) + do i = 1, 64 + l17 = i + end do + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(l18\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l18\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l18\\)" "gimple" } } + !$omp taskloop simd lastprivate (l18) default(none) + do i = 1, 64 + l18 = i + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l19\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l19\\)" "gimple" } } + !$omp teams distribute lastprivate (l19) default(none) + do i = 1, 64 + l19 = i + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l20\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l20\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l20\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l20\\)" "gimple" } } ! FIXME. + !$omp teams distribute parallel do lastprivate (l20) default(none) + do i = 1, 64 + l20 = i + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l21\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l21\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l21\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l21\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l21\\)" "gimple" } } + !$omp teams distribute parallel do simd lastprivate (l21) default(none) + do i = 1, 64 + l21 = i + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(l22\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l22\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l22\\)" "gimple" } } + !$omp teams distribute simd lastprivate (l22) default(none) + do i = 1, 64 + l22 = i + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(j03\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp teams loop lastprivate (j03) default(none) + do j03 = 1, 64 + end do +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-3.f90 index ce43dfb..854b9d6 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-3.f90 @@ -25,17 +25,17 @@ subroutine bar () ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l01\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } - !$omp master taskloop firstprivate (l01) lastprivate (l01) + !$omp master taskloop firstprivate (l01) lastprivate (l01) default(none) do i = 1, 64 l01 = i end do ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(l02\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l02\\)" "gimple" } } - ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l02\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l02\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l02\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(l02\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l02\\)" "gimple" } } - !$omp master taskloop simd firstprivate (l02) lastprivate (l02) + !$omp master taskloop simd firstprivate (l02) lastprivate (l02) default(none) do i = 1, 64 l02 = i end do @@ -43,7 +43,7 @@ subroutine bar () ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l03\\)" "gimple" } } ! FIXME: This should be on for instead. ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(l03\\)" "gimple" } } ! FIXME. ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l03\\)" "gimple" } } ! FIXME. - !$omp parallel do firstprivate (l03) lastprivate (l03) + !$omp parallel do firstprivate (l03) lastprivate (l03) default(none) do i = 1, 64 l03 = i end do @@ -54,7 +54,7 @@ subroutine bar () ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l04\\)" "gimple" } } ! FIXME. ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(l04\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l04\\)" "gimple" } } - !$omp parallel do simd firstprivate (l04) lastprivate (l04) + !$omp parallel do simd firstprivate (l04) lastprivate (l04) default(none) do i = 1, 64 l04 = i end do @@ -63,19 +63,19 @@ subroutine bar () ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(l05\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l05\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l05\\)" "gimple" } } - ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l05\\)" "gimple" { xfail *-*-* } } } - !$omp parallel master taskloop firstprivate (l05) lastprivate (l05) + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l05\\)" "gimple" } } + !$omp parallel master taskloop firstprivate (l05) lastprivate (l05) default(none) do i = 1, 64 l05 = i end do ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(l06\\)" "gimple" { xfail *-*-* } } } ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(l06\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } - ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l06\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l06\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(l06\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } - !$omp parallel master taskloop simd firstprivate (l06) lastprivate (l06) + !$omp parallel master taskloop simd firstprivate (l06) lastprivate (l06) default(none) do i = 1, 64 l06 = i end do @@ -90,7 +90,7 @@ subroutine bar () ! { dg-final { scan-tree-dump-not "omp sections\[^\n\r]*lastprivate\\(l07\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp section \[^\n\r]*firstprivate\\(l07\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp section \[^\n\r]*lastprivate\\(l07\\)" "gimple" } } - !$omp parallel sections firstprivate (l07) lastprivate (l07) + !$omp parallel sections firstprivate (l07) lastprivate (l07) default(none) l07 = 1 !$omp section l07 = 2 @@ -101,7 +101,7 @@ subroutine bar () ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l08\\)" "gimple" } } ! FIXME: This should be on for instead. ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(l08\\)" "gimple" } } ! FIXME. ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l08\\)" "gimple" } } ! FIXME. - !$omp target parallel do firstprivate (l08) lastprivate (l08) + !$omp target parallel do firstprivate (l08) lastprivate (l08) default(none) ! defaultmap(none) do i = 1, 64 l08 = i end do @@ -114,7 +114,7 @@ subroutine bar () ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l09\\)" "gimple" } } ! FIXME. ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(l09\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l09\\)" "gimple" } } - !$omp target parallel do simd firstprivate (l09) lastprivate (l09) + !$omp target parallel do simd firstprivate (l09) lastprivate (l09) default(none) ! defaultmap(none) do i = 1, 64 l09 = i end do @@ -122,15 +122,15 @@ subroutine bar () ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l10\\)" "gimple" { xfail *-*-* } } } ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(l10\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l10\\)" "gimple" } } - !$omp target simd firstprivate (l10) lastprivate (l10) + !$omp target simd firstprivate (l10) lastprivate (l10) ! defaultmap(none) do i = 1, 64 l10 = i end do - ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l11\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l11\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l11\\)" "gimple" } } ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*firstprivate\\(l11\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*lastprivate\\(l11\\)" "gimple" } } - !$omp taskloop simd firstprivate (l11) lastprivate (l11) + !$omp taskloop simd firstprivate (l11) lastprivate (l11) default(none) do i = 1, 64 l11 = i end do diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 new file mode 100644 index 0000000..5b82dd6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 @@ -0,0 +1,89 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: l00, l01, l05, l06, l07, l08 + +contains + +subroutine bar () + integer :: l02, l03, l04 + integer :: i + l02 = 0; l03 = 0; l04 = 0 + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*firstprivate\\(l00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l00:1\\)" "gimple" } } + !$omp do simd linear (l00) + do i = 1, 64 + l00 = l00 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(l01\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l01:1\\)" "gimple" } } + !$omp master taskloop simd linear (l01) default(none) + do i = 1, 64 + l01 = l01 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(l02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*linear\\(l02:1\\)" "gimple" } } + !$omp parallel do linear (l02) default(none) + do i = 1, 64 + l02 = l02 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(l03\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l03\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(l03\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l03\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l03:1\\)" "gimple" } } + !$omp parallel do simd linear (l03) default(none) + do i = 1, 64 + l03 = l03 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(l04\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*firstprivate\\(l04\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(l04\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l04\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l04\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l04:1\\)" "gimple" } } + !$omp parallel master taskloop simd linear (l04) default(none) + do i = 1, 64 + l04 = l04 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l05" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(l05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*linear\\(l05:1\\)" "gimple" } } + !$omp target parallel do linear (l05) default(none) ! defaultmap(none) + do i = 1, 64 + l05 = l05 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l06" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l06\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*firstprivate\\(l06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*firstprivate\\(l06\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l06\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l06:1\\)" "gimple" } } + !$omp target parallel do simd linear (l06) default(none) ! defaultmap(none) + do i = 1, 64 + l06 = l06 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:l07" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(l07\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l07:1\\)" "gimple" } } + !$omp target simd linear (l07) ! defaultmap(none) + do i = 1, 64 + l07 = l07 + 1 + end do + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*firstprivate\\(l08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(l08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(l08:1\\)" "gimple" } } + !$omp taskloop simd linear (l08) default(none) + do i = 1, 64 + l08 = l08 + 1 + end do +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 new file mode 100644 index 0000000..9f45e48 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 @@ -0,0 +1,107 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: j00, j01, j02, j03, j04, j06, j07, j08, j09 + integer :: j10 + +contains + +subroutine foo () + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j00:1\\)" "gimple" } } + !$omp distribute parallel do simd linear (j00) default(none) + do j00 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j01:1\\)" "gimple" } } + !$omp distribute simd linear (j01) + do j01 = 1, 64 + end do +end + +subroutine bar () + integer :: j05, j11, j12 + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(j02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j02:1\\)" "gimple" } } + !$omp do simd linear (j02) + do j02 = 1, 64 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j03\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j03:1\\)" "gimple" } } + !$omp master taskloop simd linear (j03) default(none) + do j03 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j04\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j04\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j04:1\\)" "gimple" } } + !$omp parallel do simd linear (j04) default(none) + do j04 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(j05\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(j05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j05\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j05:1\\)" "gimple" } } + !$omp parallel master taskloop simd linear (j05) default(none) + do j05 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j06" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j06\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j06\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j06:1\\)" "gimple" } } + !$omp target parallel do simd linear (j06) default(none) ! defaultmap(none) + do j06 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j07" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j07\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j07:1\\)" "gimple" } } + !$omp target simd linear (j07) ! defaultmap(none) + do j07 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j08" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j08\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j08\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j08:1\\)" "gimple" } } + !$omp target teams distribute parallel do simd linear (j08) default(none) ! defaultmap(none) + do j08 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j09" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j09:1\\)" "gimple" } } + !$omp target teams distribute simd linear (j09) default(none) ! defaultmap(none) + do j09 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j10\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j10\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j10:1\\)" "gimple" { xfail *-*-* } } } + !$omp taskloop simd linear (j10) default(none) + do j010 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j11:1\\)" "gimple" } } + !$omp teams distribute parallel do simd linear (j11) default(none) + do j11 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j12\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j12\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j12:1\\)" "gimple" } } + !$omp teams distribute simd linear (j12) default(none) + do j12 = 1, 64 + end do +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 new file mode 100644 index 0000000..37a93e6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 @@ -0,0 +1,107 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: j00, j01, j02, j03, j04, j06, j07, j08, j09 + integer :: j10 + +contains + +subroutine foo () + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j00\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j00:1\\)" "gimple" } } + !$omp distribute parallel do simd default(none) + do j00 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j01:1\\)" "gimple" } } + !$omp distribute simd + do j01 = 1, 64 + end do +end + +subroutine bar () + integer :: j05, j11, j12; + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*lastprivate\\(j02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j02:1\\)" "gimple" } } + !$omp do simd + do j02 = 1, 64 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j03\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j03:1\\)" "gimple" } } + !$omp master taskloop simd default(none) + do j03 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j04\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j04\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j04:1\\)" "gimple" } } + !$omp parallel do simd default(none) + do j04 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(j05\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*lastprivate\\(j05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j05\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j05:1\\)" "gimple" } } + !$omp parallel master taskloop simd default(none) + do j05 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j06" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j06\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j06\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j06:1\\)" "gimple" } } + !$omp target parallel do simd default(none) ! defaultmap(none) + do j06 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j07" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j07\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j07:1\\)" "gimple" } } + !$omp target simd ! defaultmap(none) + do j07 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j08" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j08\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j08\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j08:1\\)" "gimple" } } + !$omp target teams distribute parallel do simd default(none) ! defaultmap(none) + do j08 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:j09" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(j09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j09\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j09:1\\)" "gimple" } } + !$omp target teams distribute simd default(none) ! defaultmap(none) + do j09 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j10\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j10\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j10:1\\)" "gimple" } } + !$omp taskloop simd default(none) + do j10 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j11:1\\)" "gimple" } } + !$omp teams distribute parallel do simd default(none) + do j11 = 1, 64 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j12\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j12\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j12:1\\)" "gimple" } } + !$omp teams distribute simd default(none) + do j12 = 1, 64 + end do +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 new file mode 100644 index 0000000..de27ffe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 @@ -0,0 +1,252 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + integer :: r00, r01, r02, r03, r04, r05 + integer :: r13, r14, r15, r16, r17, r18, r19 + integer :: r20, r21, r22, r23, r24 + +contains + +subroutine foo () + integer :: i + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r00\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r00\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r00\\)" "gimple" } } ! FIXME. + !$omp distribute parallel do reduction(+:r00) default(none) + do i = 1, 64 + r00 = r00 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r01\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r01\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r01\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r01\\)" "gimple" } } + !$omp distribute parallel do simd reduction(+:r01) default(none) + do i = 1, 64 + r01 = r01 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r02\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r02\\)" "gimple" } } + !$omp distribute simd reduction(+:r02) + do i = 1, 64 + r02 = r02 + 1 + end do +end + +subroutine bar () + integer :: r06, r07, r08, r09 + integer :: r10, r11, r12 + integer :: r25, r26, r27, r28, r29 + integer :: i + r06 = 0; r07 = 0; r08 = 0; r09 = 0 + r10 = 0; r11 = 0; r12 = 0 + r25 = 0; r26 = 0; r27 = 0; r28 = 0; r29 = 0 + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*reduction\\(\\+:r03\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r03\\)" "gimple" } } + !$omp do simd reduction(+:r03) + do i = 1, 64 + r03 = r03 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*reduction\\(\\+:r04\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*reduction\\(\\+:r04\\)" "gimple" } } + !$omp master taskloop reduction(+:r04) default(none) + do i = 1, 64 + r04 = r04 + 1 + end do + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*reduction\\(\\+:r05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*reduction\\(\\+:r05\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r05\\)" "gimple" } } + !$omp master taskloop simd reduction(+:r05) default(none) + do i = 1, 64 + r05 = r05 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r06\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r06\\)" "gimple" } } ! FIXME. + !$omp parallel do reduction(+:r06) default(none) + do i = 1, 64 + r06 = r06 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r07\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r07\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r07\\)" "gimple" } } + !$omp parallel do simd reduction(+:r07) default(none) + do i = 1, 64 + r07 = r07 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(r08\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*reduction\\(\\+:r08\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r08\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp parallel loop reduction(+:r08) default(none) + do i = 1, 64 + r08 = r08 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r09\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*reduction\\(\\+:r09\\)" "gimple" } } + !$omp parallel master reduction(+:r09) default(none) + r09 = r09 + 1 + !$omp end parallel master + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(r10\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*reduction\\(\\+:r10\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*reduction\\(\\+:r10\\)" "gimple" } } + !$omp parallel master taskloop reduction(+:r10) default(none) + do i = 1, 64 + r10 = r10 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(r11\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*reduction\\(\\+:r11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*reduction\\(\\+:r11\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r11\\)" "gimple" } } + !$omp parallel master taskloop simd reduction(+:r11) default(none) + do i = 1, 64 + r11 = r11 + 1 + end do + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r12\\)" "gimple" } } ! FIXME: This should be on sections instead. + ! { dg-final { scan-tree-dump-not "omp sections\[^\n\r]*reduction\\(\\+:r12\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump-not "omp section \[^\n\r]*reduction\\(\\+:r12\\)" "gimple" } } + !$omp parallel sections reduction(+:r12) default(none) + r12 = r12 + 1 + !$omp section + r12 = r12 + 1 + !$omp end parallel sections + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r13" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r13\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r13\\)" "gimple" } } + !$omp target parallel reduction(+:r13) default(none) ! defaultmap(none) + r13 = r13 + 1 + !$omp end target parallel + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r14" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r14\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r14\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r14\\)" "gimple" } } ! FIXME. + !$omp target parallel do reduction(+:r14) default(none) ! defaultmap(none) + do i = 1, 64 + r14 = r14 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r15" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r15\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r15\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r15\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r15\\)" "gimple" } } + !$omp target parallel do simd reduction(+:r15) default(none) ! defaultmap(none) + do i = 1, 64 + r15 = r15 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r16" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r16\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(r16\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*reduction\\(\\+:r16\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r16\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp target parallel loop reduction(+:r16) default(none) ! defaultmap(none) + do i = 1, 64 + r16 = r16 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r17" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r17\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r17\\)" "gimple" } } + !$omp target teams reduction(+:r17) default(none) ! defaultmap(none) + r17 = r17 + 1 + !$omp end target teams + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r18" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r18\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r18\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r18\\)" "gimple" } } + !$omp target teams distribute reduction(+:r18) default(none) ! defaultmap(none) + do i = 1, 64 + r18 = r18 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r19" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r19\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r19\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r19\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r19\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r19\\)" "gimple" } } ! FIXME. + !$omp target teams distribute parallel do reduction(+:r19) default(none) ! defaultmap(none) + do i = 1, 64 + r19 = r19 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r20" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r20\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r20\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r20\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r20\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r20\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r20\\)" "gimple" } } + !$omp target teams distribute parallel do simd reduction(+:r20) default(none) ! defaultmap(none) + do i = 1, 64 + r20 = r20 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r21" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r21\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r21\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r21\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r21\\)" "gimple" } } + !$omp target teams distribute simd reduction(+:r21) default(none) ! defaultmap(none) + do i = 1, 64 + r21 = r21 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r22" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r22\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(r22\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*reduction\\(\\+:r22\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(r22\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*reduction\\(\\+:r22\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r22\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp target teams loop reduction(+:r22) default(none) ! defaultmap(none) + do i = 1, 64 + r22 = r22 + 1 + end do + ! { dg-final { scan-tree-dump "omp target\[^\n\r]*map\\(tofrom:r23" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump-not "omp target\[^\n\r]*firstprivate\\(r23\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r23\\)" "gimple" } } + !$omp target simd reduction(+:r23) ! defaultmap(none) + do i = 1, 64 + r23 = r23 + 1 + end do + ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*reduction\\(\\+:r24\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r24\\)" "gimple" } } + !$omp taskloop simd reduction(+:r24) default(none) + do i = 1, 64 + r24 = r24 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r25\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r25\\)" "gimple" } } + !$omp teams distribute reduction(+:r25) default(none) + do i = 1, 64 + r25 = r25 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r26\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r26\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r26\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r26\\)" "gimple" } } ! FIXME. + !$omp teams distribute parallel do reduction(+:r26) default(none) + do i = 1, 64 + r26 = r26 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r27\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r27\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*reduction\\(\\+:r27\\)" "gimple" } } ! FIXME: This should be on for instead. + ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*reduction\\(\\+:r27\\)" "gimple" } } ! FIXME. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r27\\)" "gimple" } } + !$omp teams distribute parallel do simd reduction(+:r27) default(none) + do i = 1, 64 + r27 = r27 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*reduction\\(\\+:r28\\)" "gimple" } } + ! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*reduction\\(\\+:r28\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r28\\)" "gimple" } } + !$omp teams distribute simd reduction(+:r28) default(none) + do i = 1, 64 + r28 = r28 + 1 + end do + ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(r29\\)" "gimple" } } + ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*reduction\\(\\+:r29\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*shared\\(r29\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp for\[^\n\r]*reduction\\(\\+:r29\\)" "gimple" } } ! NOTE: This is implementation detail. + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*reduction\\(\\+:r29\\)" "gimple" } } ! NOTE: This is implementation detail. + !$omp teams loop reduction(+:r29) default(none) + do i = 1, 64 + r29 = r29 + 1 + end do +end +end module m -- cgit v1.1 From 848a36032c8876ee45d5c81efeddb1bc657ac95c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 12:14:14 +0200 Subject: Fortran/OpenMP: omp loop's BIND clause - fix typo Missed a 'git add' after fixing this typo pointed out during review. PR middle-end/99928 gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_clauses): Fix typo in error message. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/loop-2.f90: Update for typo fix. --- gcc/fortran/openmp.c | 2 +- gcc/testsuite/gfortran.dg/gomp/loop-2.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index d7136b1..638a823 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1440,7 +1440,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->bind = OMP_BIND_THREAD; else { - gfc_error ("Expected TEAMS, PARALLEL or THEAD as binding in " + gfc_error ("Expected TEAMS, PARALLEL or THREAD as binding in " "BIND at %C"); break; } diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 index b2a0d15..0cb8661 100644 --- a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 @@ -33,7 +33,7 @@ end do do i = 1, 64 end do -!$omp loop bind(target) ! { dg-error "17: Expected TEAMS, PARALLEL or THEAD as binding in BIND" } +!$omp loop bind(target) ! { dg-error "17: Expected TEAMS, PARALLEL or THREAD as binding in BIND" } do i = 1, 64 end do -- cgit v1.1 From ed106d6544c785ca61296a64bec4b33b703dc586 Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:21:00 -0500 Subject: i386: Update unexpected empty split condition gcc/ChangeLog: * config/i386/i386.md (*load_tp_x32_zext, *add_tp_x32_zext, *tls_dynamic_gnu2_combine_32): Fix empty split condition. * config/i386/sse.md (*_pmovmskb_lt, *_pmovmskb_zext_lt, *sse2_pmovmskb_ext_lt, *_pblendvb_lt): Likewise. --- gcc/config/i386/i386.md | 6 +++--- gcc/config/i386/sse.md | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) (limited to 'gcc') diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index 960ecbd..f0bb798 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -15741,7 +15741,7 @@ (unspec:SI [(const_int 0)] UNSPEC_TP)))] "TARGET_X32" "#" - "" + "&& 1" [(set (match_dup 0) (zero_extend:DI (match_dup 1)))] { @@ -15779,7 +15779,7 @@ (clobber (reg:CC FLAGS_REG))] "TARGET_X32" "#" - "" + "&& 1" [(parallel [(set (match_dup 0) (zero_extend:DI @@ -15870,7 +15870,7 @@ (clobber (reg:CC FLAGS_REG))] "!TARGET_64BIT && TARGET_GNU2_TLS" "#" - "" + "&& 1" [(set (match_dup 0) (match_dup 5))] { operands[5] = can_create_pseudo_p () ? gen_reg_rtx (Pmode) : operands[0]; diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index 1b3df21..e4248e5 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -16562,7 +16562,7 @@ UNSPEC_MOVMSK))] "TARGET_SSE2" "#" - "" + "&& 1" [(set (match_dup 0) (unspec:SI [(match_dup 1)] UNSPEC_MOVMSK))] "" @@ -16584,7 +16584,7 @@ UNSPEC_MOVMSK)))] "TARGET_64BIT && TARGET_SSE2" "#" - "" + "&& 1" [(set (match_dup 0) (zero_extend:DI (unspec:SI [(match_dup 1)] UNSPEC_MOVMSK)))] "" @@ -16606,7 +16606,7 @@ UNSPEC_MOVMSK)))] "TARGET_64BIT && TARGET_SSE2" "#" - "" + "&& 1" [(set (match_dup 0) (sign_extend:DI (unspec:SI [(match_dup 1)] UNSPEC_MOVMSK)))] "" @@ -17911,7 +17911,7 @@ UNSPEC_BLENDV))] "TARGET_SSE4_1" "#" - "" + "&& 1" [(set (match_dup 0) (unspec:VI1_AVX2 [(match_dup 1) (match_dup 2) (match_dup 3)] UNSPEC_BLENDV))] -- cgit v1.1 From 9651794fff3a16c476e148de855d4f2136234c73 Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:20:49 -0500 Subject: arm: Update unexpected empty split condition gcc/ChangeLog: * config/arm/vfp.md (no_literal_pool_df_immediate, no_literal_pool_sf_immediate): Fix empty split condition. --- gcc/config/arm/vfp.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/config/arm/vfp.md b/gcc/config/arm/vfp.md index f97af92..55b6c1a 100644 --- a/gcc/config/arm/vfp.md +++ b/gcc/config/arm/vfp.md @@ -2129,7 +2129,7 @@ && !arm_const_double_rtx (operands[1]) && !(TARGET_VFP_DOUBLE && vfp3_const_double_rtx (operands[1]))" "#" - "" + "&& 1" [(const_int 0)] { long buf[2]; @@ -2154,7 +2154,7 @@ && TARGET_VFP_BASE && !vfp3_const_double_rtx (operands[1])" "#" - "" + "&& 1" [(const_int 0)] { long buf; -- cgit v1.1 From 78b622e37381e1c0e9992f6634972dfbe0338d0b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 13:10:57 +0200 Subject: gfortran.dg/gomp/pr99928-*.f90: Use implicit none, remove one xfail gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-1.f90: Add 'implicit none'. * gfortran.dg/gomp/pr99928-11.f90: Likewise. * gfortran.dg/gomp/pr99928-4.f90: Likewise. * gfortran.dg/gomp/pr99928-6.f90: Likewise. * gfortran.dg/gomp/pr99928-8.f90: Likewise. * gfortran.dg/gomp/pr99928-2.f90: Likewise. Add missing decl. * gfortran.dg/gomp/pr99928-5.f90: Add implicit none; fix loop-variable and remove xfail. --- gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 | 1 + gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 | 1 + gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 | 2 ++ gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 | 1 + gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 | 5 +++-- gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 | 1 + gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 | 1 + 7 files changed, 10 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 index 5cbffb0..e5be42f 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 @@ -3,6 +3,7 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: f00, f01, f02, f03, f04, f05, f06, f07, f08, f09 integer :: f12, f13, f14, f15, f16, f17, f18, f19 integer :: f20, f21, f22, f23, f24, f25, f26, f27, f28, f29 diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 index 864ae4b..22a40e2 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 @@ -3,6 +3,7 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: r00, r01, r02 contains diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 index 5dbf78b..fe8a715 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 @@ -3,12 +3,14 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: l00, l01, l02, l03, l04, l05, l06, l07 integer :: l10, l11, l12, l13, l14, l15, l16, l17, l18 contains subroutine foo () + integer :: i ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp parallel\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } ! FIXME: This should be on for instead. ! { dg-final { scan-tree-dump-not "omp for\[^\n\r]*lastprivate\\(l00\\)" "gimple" } } ! FIXME. diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 index 5b82dd6..ead8f03 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 @@ -3,6 +3,7 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: l00, l01, l05, l06, l07, l08 contains diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 index 9f45e48..c612aaf 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 @@ -3,6 +3,7 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: j00, j01, j02, j03, j04, j06, j07, j08, j09 integer :: j10 @@ -85,9 +86,9 @@ subroutine bar () end do ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*shared\\(j10\\)" "gimple" } } ! NOTE: This is implementation detail. ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j10\\)" "gimple" } } - ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j10:1\\)" "gimple" { xfail *-*-* } } } + ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j10:1\\)" "gimple" } } !$omp taskloop simd linear (j10) default(none) - do j010 = 1, 64 + do j01 = 1, 64 end do ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j11\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 index 37a93e6..0e60199 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 @@ -3,6 +3,7 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: j00, j01, j02, j03, j04, j06, j07, j08, j09 integer :: j10 diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 index de27ffe..a5b028b 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 @@ -3,6 +3,7 @@ ! { dg-options "-fopenmp -fdump-tree-gimple" } module m + implicit none integer :: r00, r01, r02, r03, r04, r05 integer :: r13, r14, r15, r16, r17, r18, r19 integer :: r20, r21, r22, r23, r24 -- cgit v1.1 From ad3f0ad4bafe377072a53ded468fd9948e659f46 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 13:26:40 +0200 Subject: gfortran.dg/gomp/pr99928-5.f90: Use proper iteration var gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-5.f90: Really use the proper iteration variable. --- gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 index c612aaf..49cbf1e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 @@ -88,7 +88,7 @@ subroutine bar () ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*lastprivate\\(j10\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp simd\[^\n\r]*linear\\(j10:1\\)" "gimple" } } !$omp taskloop simd linear (j10) default(none) - do j01 = 1, 64 + do j10 = 1, 64 end do ! { dg-final { scan-tree-dump "omp teams\[^\n\r]*shared\\(j11\\)" "gimple" } } ! { dg-final { scan-tree-dump "omp distribute\[^\n\r]*lastprivate\\(j11\\)" "gimple" } } -- cgit v1.1 From 8d7dae0eb366a88a1baba1857ecc54c09e4a520e Mon Sep 17 00:00:00 2001 From: Uros Bizjak Date: Fri, 4 Jun 2021 17:37:15 +0200 Subject: i386: Add init pattern for V2HI vectors [PR100637] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 2021-06-03 Uroš Bizjak gcc/ PR target/100637 * config/i386/i386-expand.c (ix86_expand_vector_init_duplicate): Handle V2HI mode. (ix86_expand_vector_init_general): Ditto. Use SImode instead of word_mode for logic operations when GET_MODE_SIZE (mode) < UNITS_PER_WORD. (expand_vec_perm_even_odd_1): Assert that V2HI mode should be implemented by expand_vec_perm_1. (expand_vec_perm_broadcast_1): Assert that V2HI and V4HI modes should be implemented using standard shuffle patterns. (ix86_vectorize_vec_perm_const): Handle V2HImode. Add V4HI and V2HI modes to modes, implementable with shuffle for one operand. * config/i386/mmx.md (*punpckwd): New insn_and_split pattern. (*pshufw_1): New insn pattern. (*vec_dupv2hi): Ditto. (vec_initv2hihi): New expander. gcc/testsuite/ PR target/100637 * gcc.dg/vect/slp-perm-9.c (dg-final): Adjust dumps for vect32 targets. --- gcc/config/i386/i386-expand.c | 45 ++++++++++++++----- gcc/config/i386/mmx.md | 82 ++++++++++++++++++++++++++++++++++ gcc/testsuite/gcc.dg/vect/slp-perm-9.c | 8 ++-- 3 files changed, 121 insertions(+), 14 deletions(-) (limited to 'gcc') diff --git a/gcc/config/i386/i386-expand.c b/gcc/config/i386/i386-expand.c index 68bb5ab..804cb59 100644 --- a/gcc/config/i386/i386-expand.c +++ b/gcc/config/i386/i386-expand.c @@ -13723,6 +13723,19 @@ ix86_expand_vector_init_duplicate (bool mmx_ok, machine_mode mode, } goto widen; + case E_V2HImode: + if (TARGET_SSE2) + { + rtx x; + + val = gen_lowpart (SImode, val); + x = gen_rtx_TRUNCATE (HImode, val); + x = gen_rtx_VEC_DUPLICATE (mode, x); + emit_insn (gen_rtx_SET (target, x)); + return true; + } + return false; + case E_V8QImode: if (!mmx_ok) return false; @@ -14524,6 +14537,8 @@ quarter: case E_V4HImode: case E_V8QImode: + + case E_V2HImode: break; default: @@ -14532,12 +14547,14 @@ quarter: { int i, j, n_elts, n_words, n_elt_per_word; - machine_mode inner_mode; + machine_mode tmp_mode, inner_mode; rtx words[4], shift; + tmp_mode = (GET_MODE_SIZE (mode) < UNITS_PER_WORD) ? SImode : word_mode; + inner_mode = GET_MODE_INNER (mode); n_elts = GET_MODE_NUNITS (mode); - n_words = GET_MODE_SIZE (mode) / UNITS_PER_WORD; + n_words = GET_MODE_SIZE (mode) / GET_MODE_SIZE (tmp_mode); n_elt_per_word = n_elts / n_words; shift = GEN_INT (GET_MODE_BITSIZE (inner_mode)); @@ -14548,15 +14565,15 @@ quarter: for (j = 0; j < n_elt_per_word; ++j) { rtx elt = XVECEXP (vals, 0, (i+1)*n_elt_per_word - j - 1); - elt = convert_modes (word_mode, inner_mode, elt, true); + elt = convert_modes (tmp_mode, inner_mode, elt, true); if (j == 0) word = elt; else { - word = expand_simple_binop (word_mode, ASHIFT, word, shift, + word = expand_simple_binop (tmp_mode, ASHIFT, word, shift, word, 1, OPTAB_LIB_WIDEN); - word = expand_simple_binop (word_mode, IOR, word, elt, + word = expand_simple_binop (tmp_mode, IOR, word, elt, word, 1, OPTAB_LIB_WIDEN); } } @@ -14570,14 +14587,14 @@ quarter: { rtx tmp = gen_reg_rtx (mode); emit_clobber (tmp); - emit_move_insn (gen_lowpart (word_mode, tmp), words[0]); - emit_move_insn (gen_highpart (word_mode, tmp), words[1]); + emit_move_insn (gen_lowpart (tmp_mode, tmp), words[0]); + emit_move_insn (gen_highpart (tmp_mode, tmp), words[1]); emit_move_insn (target, tmp); } else if (n_words == 4) { rtx tmp = gen_reg_rtx (V4SImode); - gcc_assert (word_mode == SImode); + gcc_assert (tmp_mode == SImode); vals = gen_rtx_PARALLEL (V4SImode, gen_rtvec_v (4, words)); ix86_expand_vector_init_general (false, V4SImode, tmp, vals); emit_move_insn (target, gen_lowpart (mode, tmp)); @@ -19548,6 +19565,7 @@ expand_vec_perm_even_odd_1 (struct expand_vec_perm_d *d, unsigned odd) case E_V2DImode: case E_V2SImode: case E_V4SImode: + case E_V2HImode: /* These are always directly implementable by expand_vec_perm_1. */ gcc_unreachable (); @@ -19758,6 +19776,8 @@ expand_vec_perm_broadcast_1 (struct expand_vec_perm_d *d) case E_V2DImode: case E_V2SImode: case E_V4SImode: + case E_V2HImode: + case E_V4HImode: /* These are always implementable using standard shuffle patterns. */ gcc_unreachable (); @@ -20267,6 +20287,10 @@ ix86_vectorize_vec_perm_const (machine_mode vmode, rtx target, rtx op0, if (!TARGET_MMX_WITH_SSE) return false; break; + case E_V2HImode: + if (!TARGET_SSE2) + return false; + break; case E_V2DImode: case E_V2DFmode: if (!TARGET_SSE) @@ -20298,10 +20322,11 @@ ix86_vectorize_vec_perm_const (machine_mode vmode, rtx target, rtx op0, /* Check whether the mask can be applied to the vector type. */ d.one_operand_p = (which != 3); - /* Implementable with shufps or pshufd. */ + /* Implementable with shufps, pshufd or pshuflw. */ if (d.one_operand_p && (d.vmode == V4SFmode || d.vmode == V2SFmode - || d.vmode == V4SImode || d.vmode == V2SImode)) + || d.vmode == V4SImode || d.vmode == V2SImode + || d.vmode == V4HImode || d.vmode == V2HImode)) return true; /* Otherwise we have to go through the motions and see if we can diff --git a/gcc/config/i386/mmx.md b/gcc/config/i386/mmx.md index 914e5e9..c3fd280 100644 --- a/gcc/config/i386/mmx.md +++ b/gcc/config/i386/mmx.md @@ -3292,6 +3292,88 @@ DONE; }) +(define_insn_and_split "*punpckwd" + [(set (match_operand:V2HI 0 "register_operand" "=x,Yw") + (vec_select:V2HI + (vec_concat:V4HI + (match_operand:V2HI 1 "register_operand" "0,Yw") + (match_operand:V2HI 2 "register_operand" "x,Yw")) + (parallel [(match_operand 3 "const_0_to_3_operand") + (match_operand 4 "const_0_to_3_operand")])))] + "TARGET_SSE2" + "#" + "&& reload_completed" + [(set (match_dup 5) + (vec_select:V4HI + (match_dup 5) + (parallel [(match_dup 3) (match_dup 4) + (const_int 0) (const_int 0)])))] +{ + rtx dest = lowpart_subreg (V8HImode, operands[0], V2HImode); + rtx op1 = lowpart_subreg (V8HImode, operands[1], V2HImode); + rtx op2 = lowpart_subreg (V8HImode, operands[2], V2HImode); + + emit_insn (gen_vec_interleave_lowv8hi (dest, op1, op2)); + + static const int map[4] = { 0, 2, 1, 3 }; + + int sel0 = map[INTVAL (operands[3])]; + int sel1 = map[INTVAL (operands[4])]; + + if (sel0 == 0 && sel1 == 1) + DONE; + + operands[3] = GEN_INT (sel0); + operands[4] = GEN_INT (sel1); + + operands[5] = lowpart_subreg (V4HImode, dest, V8HImode); +} + [(set_attr "isa" "noavx,avx") + (set_attr "type" "sselog") + (set_attr "mode" "TI")]) + +(define_insn "*pshufw_1" + [(set (match_operand:V2HI 0 "register_operand" "=Yw") + (vec_select:V2HI + (match_operand:V2HI 1 "register_operand" "Yw") + (parallel [(match_operand 2 "const_0_to_1_operand") + (match_operand 3 "const_0_to_1_operand")])))] + "TARGET_SSE2" +{ + int mask = 0; + mask |= INTVAL (operands[2]) << 0; + mask |= INTVAL (operands[3]) << 2; + mask |= 2 << 4; + mask |= 3 << 6; + operands[2] = GEN_INT (mask); + + return "%vpshuflw\t{%2, %1, %0|%0, %1, %2}"; +} + [(set_attr "type" "sselog1") + (set_attr "length_immediate" "1") + (set_attr "mode" "TI")]) + +(define_insn "*vec_dupv2hi" + [(set (match_operand:V2HI 0 "register_operand" "=Yw") + (vec_duplicate:V2HI + (truncate:HI + (match_operand:SI 1 "register_operand" "Yw"))))] + "TARGET_SSE2" + "%vpshuflw\t{$0, %1, %0|%0, %1, 0}" + [(set_attr "type" "sselog1") + (set_attr "length_immediate" "1") + (set_attr "mode" "TI")]) + +(define_expand "vec_initv2hihi" + [(match_operand:V2HI 0 "register_operand") + (match_operand 1)] + "TARGET_SSE2" +{ + ix86_expand_vector_init (false, operands[0], + operands[1]); + DONE; +}) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Miscellaneous diff --git a/gcc/testsuite/gcc.dg/vect/slp-perm-9.c b/gcc/testsuite/gcc.dg/vect/slp-perm-9.c index ab75f44..873eddf 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-perm-9.c +++ b/gcc/testsuite/gcc.dg/vect/slp-perm-9.c @@ -57,13 +57,13 @@ int main (int argc, const char* argv[]) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 2 "vect" { target { ! { vect_perm_short || vect_load_lanes } } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_perm_short || vect_load_lanes } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 2 "vect" { target { ! { { vect_perm_short || vect32 } || vect_load_lanes } } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { { vect_perm_short || vect32 } || vect_load_lanes } } } } */ /* We don't try permutes with a group size of 3 for variable-length vectors. */ /* { dg-final { scan-tree-dump-times "permutation requires at least three vectors" 1 "vect" { target { vect_perm_short && { { ! vect_perm3_short } && { ! vect_partial_vectors_usage_1 } } } xfail vect_variable_length } } } */ /* Try to vectorize the epilogue using partial vectors. */ /* { dg-final { scan-tree-dump-times "permutation requires at least three vectors" 2 "vect" { target { vect_perm_short && { { ! vect_perm3_short } && vect_partial_vectors_usage_1 } } xfail vect_variable_length } } } */ /* { dg-final { scan-tree-dump-not "permutation requires at least three vectors" "vect" { target vect_perm3_short } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 0 "vect" { target { { ! vect_perm3_short } || vect_load_lanes } } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" { target { vect_perm3_short && { ! vect_load_lanes } } } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 0 "vect" { target { { ! { vect_perm3_short || vect32 } } || vect_load_lanes } } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" { target { { vect_perm3_short || vect32 } && { ! vect_load_lanes } } } } } */ -- cgit v1.1 From 4facf2bf5b7b32f444da864306b5c11e14c15bcf Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 17:43:59 +0200 Subject: Fortran: Fix OpenMP/OpenACC continue-line parsing gcc/fortran/ChangeLog: * scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if this is not an (OpenMP) continuation line. (skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC. (gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC continuation once per location and return '\n'. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/omp-fixed.f: Re-add test item changed in previous commit in addition - add more dg-errors and '... end ...' due to changed parsing. * gfortran.dg/goacc/omp.f95: Likewise. * gfortran.dg/goacc-gomp/mixed-1.f: New test. --- gcc/fortran/scanner.c | 35 +++++++++++++++++--------- gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f | 23 +++++++++++++++++ gcc/testsuite/gfortran.dg/goacc/omp-fixed.f | 10 +++++++- gcc/testsuite/gfortran.dg/goacc/omp.f95 | 12 +++++++++ 4 files changed, 67 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f (limited to 'gcc') diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 74c5461..39db099 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -942,6 +942,8 @@ skip_fixed_omp_sentinel (locus *start) && (continue_flag || c == ' ' || c == '\t' || c == '0')) { + if (c == ' ' || c == '\t' || c == '0') + openacc_flag = 0; do c = next_char (); while (gfc_is_whitespace (c)); @@ -971,6 +973,8 @@ skip_fixed_oacc_sentinel (locus *start) && (continue_flag || c == ' ' || c == '\t' || c == '0')) { + if (c == ' ' || c == '\t' || c == '0') + openmp_flag = 0; do c = next_char (); while (gfc_is_whitespace (c)); @@ -1205,6 +1209,7 @@ gfc_skip_comments (void) gfc_char_t gfc_next_char_literal (gfc_instring in_string) { + static locus omp_acc_err_loc = {}; locus old_loc; int i, prev_openmp_flag, prev_openacc_flag; gfc_char_t c; @@ -1403,14 +1408,16 @@ restart: { if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i]) is_openmp = 1; - if (i == 4) - old_loc = gfc_current_locus; } - gfc_error (is_openmp - ? G_("Wrong OpenACC continuation at %C: " - "expected !$ACC, got !$OMP") - : G_("Wrong OpenMP continuation at %C: " - "expected !$OMP, got !$ACC")); + if (omp_acc_err_loc.nextc != gfc_current_locus.nextc + || omp_acc_err_loc.lb != gfc_current_locus.lb) + gfc_error_now (is_openmp + ? G_("Wrong OpenACC continuation at %C: " + "expected !$ACC, got !$OMP") + : G_("Wrong OpenMP continuation at %C: " + "expected !$OMP, got !$ACC")); + omp_acc_err_loc = gfc_current_locus; + goto not_continuation; } if (c != '&') @@ -1511,11 +1518,15 @@ restart: if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i]) is_openmp = 1; } - gfc_error (is_openmp - ? G_("Wrong OpenACC continuation at %C: " - "expected !$ACC, got !$OMP") - : G_("Wrong OpenMP continuation at %C: " - "expected !$OMP, got !$ACC")); + if (omp_acc_err_loc.nextc != gfc_current_locus.nextc + || omp_acc_err_loc.lb != gfc_current_locus.lb) + gfc_error_now (is_openmp + ? G_("Wrong OpenACC continuation at %C: " + "expected !$ACC, got !$OMP") + : G_("Wrong OpenMP continuation at %C: " + "expected !$OMP, got !$ACC")); + omp_acc_err_loc = gfc_current_locus; + goto not_continuation; } else if (!openmp_flag && !openacc_flag) for (i = 0; i < 5; i++) diff --git a/gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f b/gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f new file mode 100644 index 0000000..2e12f17 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f @@ -0,0 +1,23 @@ +! { dg-additional-options "-fdump-tree-original" } + + ! OMP PARALLEL gets parsed and is properly handled + ! But ACC& gives an error + ! [Before: an error is printed but OMP parses 'parallel loop ...'] + subroutine one + implicit none + integer i +!$omp parallel +!$acc& loop independent ! { dg-error "Wrong OpenMP continuation at .1.: expected !.OMP, got !.ACC" } + do i = 1, 5 + end do +!$omp end parallel + end + + ! [Before: Bogus 'Wrong OpenMP continuation' as it was read as continuation line!] + subroutine two +!$omp parallel +!$acc loop independent ! { dg-error "The !.ACC LOOP directive cannot be specified within a !.OMP PARALLEL region" } + do i = 1, 5 + end do +!$omp end parallel + end diff --git a/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f index 6ce6f73..b1e7aff 100644 --- a/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f +++ b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f @@ -6,7 +6,7 @@ !$OMP PARALLEL !$ACC PARALLEL & -!$ACC& COPYIN(ARGC) ! { dg-error "directive cannot be specified within" } +!$ACC& COPYIN(ARGC) ! { dg-error "The !.ACC PARALLEL directive cannot be specified within a !.OMP PARALLEL region" } IF (ARGC .NE. 0) THEN STOP 1 END IF @@ -24,9 +24,17 @@ !$OMP& DO ! { dg-error "Wrong OpenACC continuation" } DO I = 1, 10 ENDDO +!$ACC END PARALLEL !$OMP PARALLEL & !$ACC& KERNELS LOOP ! { dg-error "Wrong OpenMP continuation" } DO I = 1, 10 ENDDO +!$OMP END PARALLEL + +!$OMP PARALLEL & +!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" } + DO I = 1, 10 + ENDDO +!$OMP END PARALLEL END SUBROUTINE NI diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95 index 8b3b259..d8bd886 100644 --- a/gcc/testsuite/gfortran.dg/goacc/omp.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/omp.f95 @@ -67,8 +67,20 @@ contains subroutine nana !$acc parallel & !$omp do ! { dg-error "Wrong OpenACC continuation" } + do i = 1, 5 ! { dg-error "The !.OMP DO directive cannot be specified within a !.ACC PARALLEL region" "" { target *-*-* } .-1 } + end do + !$acc end parallel !$omp parallel & !$acc kernels loop ! { dg-error "Wrong OpenMP continuation" } + do i = 1, 5 ! { dg-error "The !.ACC KERNELS LOOP directive cannot be specified within a !.OMP PARALLEL region" "" { target *-*-* } .-1 } + end do + !$omp end parallel + + !$omp parallel & + !$acc loop ! { dg-error "Wrong OpenMP continuation" } + do i = 1, 5 ! { dg-error "The !.ACC LOOP directive cannot be specified within a !.OMP PARALLEL region" "" { target *-*-* } .-1 } + end do + !$omp end parallel end subroutine nana end module test -- cgit v1.1 From 1b51f038cf027fdc1bf00240cacee59dd5cbe458 Mon Sep 17 00:00:00 2001 From: Uros Bizjak Date: Fri, 4 Jun 2021 17:51:05 +0200 Subject: i386: Convert a couple of predicates to use match_code RTXes. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit No functional changes. 2021-06-04 Uroš Bizjak gcc/ * config/i386/predicates.md (GOT_memory_operand): Implement using match_code RTXes. (GOT32_symbol_operand): Ditto. --- gcc/config/i386/predicates.md | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) (limited to 'gcc') diff --git a/gcc/config/i386/predicates.md b/gcc/config/i386/predicates.md index abd307e..d2f5f15 100644 --- a/gcc/config/i386/predicates.md +++ b/gcc/config/i386/predicates.md @@ -734,13 +734,10 @@ ;; Return true if OP is a GOT memory operand. (define_predicate "GOT_memory_operand" - (match_operand 0 "memory_operand") -{ - op = XEXP (op, 0); - return (GET_CODE (op) == CONST - && GET_CODE (XEXP (op, 0)) == UNSPEC - && XINT (XEXP (op, 0), 1) == UNSPEC_GOTPCREL); -}) + (and (match_operand 0 "memory_operand") + (match_code "const" "0") + (match_code "unspec" "00") + (match_test "XINT (XEXP (XEXP (op, 0), 0), 1) == UNSPEC_GOTPCREL"))) ;; Test for a valid operand for a call instruction. ;; Allow constant call address operands in Pmode only. @@ -767,9 +764,9 @@ ;; Return true if OP is a 32-bit GOT symbol operand. (define_predicate "GOT32_symbol_operand" - (match_test "GET_CODE (op) == CONST - && GET_CODE (XEXP (op, 0)) == UNSPEC - && XINT (XEXP (op, 0), 1) == UNSPEC_GOT")) + (and (match_code "const") + (match_code "unspec" "0") + (match_test "XINT (XEXP (op, 0), 1) == UNSPEC_GOT"))) ;; Match exactly zero. (define_predicate "const0_operand" -- cgit v1.1 From c6503fa93b5565c922f76611a55b0a53cd940a5f Mon Sep 17 00:00:00 2001 From: Martin Sebor Date: Fri, 4 Jun 2021 10:35:27 -0600 Subject: PR c/100719 - missing -Wvla-parameter on a mismatch in second parameter gcc/ChangeLog: * attribs.c (init_attr_rdwr_indices): Use VLA bounds in the expected order. (attr_access::vla_bounds): Also handle VLA bounds. gcc/c-family/ChangeLog: * c-warn.c (warn_parm_array_mismatch): Check TREE_PURPOSE to test for element presence. gcc/testsuite/ChangeLog: * gcc.dg/Wvla-parameter-10.c: New test. * gcc.dg/Wvla-parameter-11.c: New test. --- gcc/attribs.c | 21 ++++++---- gcc/c-family/c-warn.c | 2 +- gcc/testsuite/gcc.dg/Wvla-parameter-10.c | 68 +++++++++++++++++++++++++++++++ gcc/testsuite/gcc.dg/Wvla-parameter-11.c | 70 ++++++++++++++++++++++++++++++++ 4 files changed, 153 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/Wvla-parameter-10.c create mode 100644 gcc/testsuite/gcc.dg/Wvla-parameter-11.c (limited to 'gcc') diff --git a/gcc/attribs.c b/gcc/attribs.c index ebc0783..70e0a2f 100644 --- a/gcc/attribs.c +++ b/gcc/attribs.c @@ -2126,14 +2126,14 @@ init_attr_rdwr_indices (rdwr_map *rwm, tree attrs) /* The (optional) list of VLA bounds. */ tree vblist = TREE_CHAIN (mode); - if (vblist) - vblist = TREE_VALUE (vblist); - mode = TREE_VALUE (mode); if (TREE_CODE (mode) != STRING_CST) continue; gcc_assert (TREE_CODE (mode) == STRING_CST); + if (vblist) + vblist = nreverse (copy_list (TREE_VALUE (vblist))); + for (const char *m = TREE_STRING_POINTER (mode); *m; ) { attr_access acc = { }; @@ -2308,11 +2308,18 @@ attr_access::to_external_string () const unsigned attr_access::vla_bounds (unsigned *nunspec) const { + unsigned nbounds = 0; *nunspec = 0; - for (const char* p = strrchr (str, ']'); p && *p != '['; --p) - if (*p == '*') - ++*nunspec; - return list_length (size); + /* STR points to the beginning of the specified string for the current + argument that may be followed by the string for the next argument. */ + for (const char* p = strchr (str, ']'); p && *p != '['; --p) + { + if (*p == '*') + ++*nunspec; + else if (*p == '$') + ++nbounds; + } + return nbounds; } /* Reset front end-specific attribute access data from ATTRS. diff --git a/gcc/c-family/c-warn.c b/gcc/c-family/c-warn.c index c48dc2e..a587b99 100644 --- a/gcc/c-family/c-warn.c +++ b/gcc/c-family/c-warn.c @@ -3511,7 +3511,7 @@ warn_parm_array_mismatch (location_t origloc, tree fndecl, tree newparms) && newa->sizarg != UINT_MAX && newa->sizarg == cura->sizarg && newa->minsize == cura->minsize - && !TREE_CHAIN (newa->size) && !TREE_CHAIN (cura->size)) + && !TREE_PURPOSE (newa->size) && !TREE_PURPOSE (cura->size)) continue; if (newa->size || cura->size) diff --git a/gcc/testsuite/gcc.dg/Wvla-parameter-10.c b/gcc/testsuite/gcc.dg/Wvla-parameter-10.c new file mode 100644 index 0000000..68db3ed --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wvla-parameter-10.c @@ -0,0 +1,68 @@ +/* PR c/100719 - missing -Wvla-parameter on a mismatch in second parameter + { dg-do compile } + { dg-options "-Wall" } */ + +typedef struct A1 { int i; } A1; +typedef struct A2 { int i; } A2; +typedef struct A3 { int i; } A3; + +void f2 (int n, A1[n], A2[n]); +void f2 (int n, A1[n], A2[n]); + +void f2_x1 (int n, A1[n], A2[n]); // { dg-note "previously declared as 'A1\\\[n]' with bound argument 1" } +void f2_x1 (int n, A1[n + 1], A2[n]); // { dg-warning "argument 2 of type 'A1\\\[n \\+ 1]' declared with mismatched bound 'n \\+ 1'" } + +void f2_x2 (int n, A1[n], A2[n]); // { dg-note "previously declared as 'A2\\\[n]' with bound argument 1" } +void f2_x2 (int n, A1[n], A2[n + 2]); // { dg-warning "argument 3 of type 'A2\\\[n \\+ 2]' declared with mismatched bound 'n \\+ 2'" } + + +void f3 (int n, A1[n], A2[n], A3[n]); +void f3 (int n, A1[n], A2[n], A3[n]); + +void f3_x1 (int n, A1[n], A2[n], A3[n]); +// { dg-note "previously declared as 'A1\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void f3_x1 (int n, A1[n + 1], A2[n], A3[n]); +// { dg-warning "argument 2 of type 'A1\\\[n \\+ 1]' declared with mismatched bound 'n \\+ 1'" "" { target *-*-* } .-1 } + +void f3_x2 (int n, A1[n], A2[n], A3[n]); +// { dg-note "previously declared as 'A2\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void f3_x2 (int n, A1[n], A2[n + 2], A3[n]); +// { dg-warning "argument 3 of type 'A2\\\[n \\+ 2]' declared with mismatched bound 'n \\+ 2'" "" { target *-*-* } .-1 } + +void f3_x3 (int n, A1[n], A2[n], A3[n]); +// { dg-note "previously declared as 'A3\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void f3_x3 (int n, A1[n], A2[n], A3[n + 3]); +// { dg-warning "argument 4 of type 'A3\\\[n \\+ 3]' declared with mismatched bound 'n \\+ 3'" "" { target *-*-* } .-1 } + + +void g3_x1 (int n, A1[n], A2[*], A3[n]); +// { dg-note "previously declared as 'A1\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void g3_x1 (int n, A1[n + 1], A2[*], A3[n]); +// { dg-warning "argument 2 of type 'A1\\\[n \\+ 1]' declared with mismatched bound 'n \\+ 1'" "" { target *-*-* } .-1 } + +void g3_x2 (int n, A1[*], A2[n], A3[n]); +// { dg-note "previously declared as 'A2\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void g3_x2 (int n, A1[*], A2[n + 2], A3[n]); +// { dg-warning "argument 3 of type 'A2\\\[n \\+ 2]' declared with mismatched bound 'n \\+ 2'" "" { target *-*-* } .-1 } + +void g3_x3 (int n, A1[*], A2[*], A3[n]); +// { dg-note "previously declared as 'A3\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void g3_x3 (int n, A1[*], A2[*], A3[n + 3]); +// { dg-warning "argument 4 of type 'A3\\\[n \\+ 3]' declared with mismatched bound 'n \\+ 3'" "" { target *-*-* } .-1 } + + +void h3_x1 (int n, A1[n], A2[ ], A3[n]); +// { dg-note "previously declared as 'A1\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void h3_x1 (int n, A1[n + 1], A2[ ], A3[n]); +// { dg-warning "argument 2 of type 'A1\\\[n \\+ 1]' declared with mismatched bound 'n \\+ 1'" "" { target *-*-* } .-1 } + +void h3_x2 (int n, A1[ ], A2[n], A3[n]); +// { dg-note "previously declared as 'A2\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void h3_x2 (int n, A1[ ], A2[n + 2], A3[n]); +// { dg-warning "argument 3 of type 'A2\\\[n \\+ 2]' declared with mismatched bound 'n \\+ 2'" "" { target *-*-* } .-1 } + +void h3_x3 (int n, A1[ ], A2[ ], A3[n]); +// { dg-note "previously declared as 'A3\\\[n]' with bound argument 1" "note" { target *-*-* } .-1 } +void h3_x3 (int n, A1[ ], A2[ ], A3[n + 3]); +// { dg-warning "argument 4 of type 'A3\\\[n \\+ 3]' declared with mismatched bound 'n \\+ 3'" "" { target *-*-* } .-1 } + diff --git a/gcc/testsuite/gcc.dg/Wvla-parameter-11.c b/gcc/testsuite/gcc.dg/Wvla-parameter-11.c new file mode 100644 index 0000000..39886a2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wvla-parameter-11.c @@ -0,0 +1,70 @@ +/* PR c/100719 - missing -Wvla-parameter on a mismatch in second parameter + { dg-do compile } + { dg-options "-Wall" } */ + +typedef struct A1 { int i; } A1; +typedef struct A2 { int i; } A2; +typedef struct A3 { int i; } A3; + +extern int n, n1, n2, n3; + +void f2 (int, A1[n], A2[n]); +void f2 (int, A1[n], A2[n]); + +void f2_x1 (int, A1[n], A2[n]); // { dg-note "previously declared as 'A1\\\[n]'" } +void f2_x1 (int, A1[n1], A2[n]); // { dg-warning "argument 2 of type 'A1\\\[n1]' declared with mismatched bound 'n1'" } + +void f2_x2 (int, A1[n], A2[n]); // { dg-note "previously declared as 'A2\\\[n]'" } +void f2_x2 (int, A1[n], A2[n2]); // { dg-warning "argument 3 of type 'A2\\\[n2]' declared with mismatched bound 'n2'" } + + +void f3 (int, A1[n], A2[n], A3[n]); +void f3 (int, A1[n], A2[n], A3[n]); + +void f3_x1 (int, A1[n], A2[n], A3[n]); +// { dg-note "previously declared as 'A1\\\[n]'" "note" { target *-*-* } .-1 } +void f3_x1 (int, A1[n1], A2[n], A3[n]); +// { dg-warning "argument 2 of type 'A1\\\[n1]' declared with mismatched bound 'n1'" "" { target *-*-* } .-1 } + +void f3_x2 (int, A1[n], A2[n], A3[n]); +// { dg-note "previously declared as 'A2\\\[n]'" "note" { target *-*-* } .-1 } +void f3_x2 (int, A1[n], A2[n2], A3[n]); +// { dg-warning "argument 3 of type 'A2\\\[n2]' declared with mismatched bound 'n2'" "" { target *-*-* } .-1 } + +void f3_x3 (int, A1[n], A2[n], A3[n]); +// { dg-note "previously declared as 'A3\\\[n]'" "note" { target *-*-* } .-1 } +void f3_x3 (int, A1[n], A2[n], A3[n3]); +// { dg-warning "argument 4 of type 'A3\\\[n3]' declared with mismatched bound 'n3'" "" { target *-*-* } .-1 } + + +void g3_x1 (int, A1[n], A2[*], A3[n]); +// { dg-note "previously declared as 'A1\\\[n]'" "note" { target *-*-* } .-1 } +void g3_x1 (int, A1[n1], A2[*], A3[n]); +// { dg-warning "argument 2 of type 'A1\\\[n1]' declared with mismatched bound 'n1'" "" { target *-*-* } .-1 } + +void g3_x2 (int, A1[*], A2[n], A3[n]); +// { dg-note "previously declared as 'A2\\\[n]'" "note" { target *-*-* } .-1 } +void g3_x2 (int, A1[*], A2[n2], A3[n]); +// { dg-warning "argument 3 of type 'A2\\\[n2]' declared with mismatched bound 'n2'" "" { target *-*-* } .-1 } + +void g3_x3 (int, A1[*], A2[*], A3[n]); +// { dg-note "previously declared as 'A3\\\[n]'" "note" { target *-*-* } .-1 } +void g3_x3 (int, A1[*], A2[*], A3[n3]); +// { dg-warning "argument 4 of type 'A3\\\[n3]' declared with mismatched bound 'n3'" "" { target *-*-* } .-1 } + + +void h3_x1 (int, A1[n], A2[ ], A3[n]); +// { dg-note "previously declared as 'A1\\\[n]'" "note" { target *-*-* } .-1 } +void h3_x1 (int, A1[n1], A2[ ], A3[n]); +// { dg-warning "argument 2 of type 'A1\\\[n1]' declared with mismatched bound 'n1'" "" { target *-*-* } .-1 } + +void h3_x2 (int, A1[ ], A2[n], A3[n]); +// { dg-note "previously declared as 'A2\\\[n]'" "note" { target *-*-* } .-1 } +void h3_x2 (int, A1[ ], A2[n2], A3[n]); +// { dg-warning "argument 3 of type 'A2\\\[n2]' declared with mismatched bound 'n2'" "" { target *-*-* } .-1 } + +void h3_x3 (int, A1[ ], A2[ ], A3[n]); +// { dg-note "previously declared as 'A3\\\[n]'" "note" { target *-*-* } .-1 } +void h3_x3 (int, A1[ ], A2[ ], A3[n3]); +// { dg-warning "argument 4 of type 'A3\\\[n3]' declared with mismatched bound 'n3'" "" { target *-*-* } .-1 } + -- cgit v1.1 From 9816f509db4966fcb90ed3baab72cc6cd901f06c Mon Sep 17 00:00:00 2001 From: Martin Sebor Date: Fri, 4 Jun 2021 10:49:06 -0600 Subject: PR middle-end/100732 - ICE on sprintf %s with integer argument gcc/ChangeLog: PR middle-end/100732 * gimple-fold.c (gimple_fold_builtin_sprintf): Avoid folding calls with either source or destination argument of invalid type. * tree-ssa-uninit.c (maybe_warn_pass_by_reference): Avoid checking calls with arguments of invalid type. gcc/testsuite/ChangeLog: PR middle-end/100732 * gcc.dg/tree-ssa/builtin-snprintf-11.c: New test. * gcc.dg/tree-ssa/builtin-snprintf-12.c: New test. * gcc.dg/tree-ssa/builtin-sprintf-28.c: New test. * gcc.dg/tree-ssa/builtin-sprintf-29.c: New test. * gcc.dg/uninit-pr100732.c: New test. --- gcc/gimple-fold.c | 30 ++++++++-------- .../gcc.dg/tree-ssa/builtin-snprintf-11.c | 32 +++++++++++++++++ .../gcc.dg/tree-ssa/builtin-snprintf-12.c | 36 +++++++++++++++++++ gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-28.c | 30 ++++++++++++++++ gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-29.c | 40 ++++++++++++++++++++++ gcc/testsuite/gcc.dg/uninit-pr100732.c | 21 ++++++++++++ gcc/tree-ssa-uninit.c | 3 ++ 7 files changed, 176 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-11.c create mode 100644 gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-12.c create mode 100644 gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-28.c create mode 100644 gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-29.c create mode 100644 gcc/testsuite/gcc.dg/uninit-pr100732.c (limited to 'gcc') diff --git a/gcc/gimple-fold.c b/gcc/gimple-fold.c index eaf0fb7..1c0e930 100644 --- a/gcc/gimple-fold.c +++ b/gcc/gimple-fold.c @@ -3514,10 +3514,6 @@ bool gimple_fold_builtin_sprintf (gimple_stmt_iterator *gsi) { gimple *stmt = gsi_stmt (*gsi); - tree dest = gimple_call_arg (stmt, 0); - tree fmt = gimple_call_arg (stmt, 1); - tree orig = NULL_TREE; - const char *fmt_str = NULL; /* Verify the required arguments in the original call. We deal with two types of sprintf() calls: 'sprintf (str, fmt)' and @@ -3525,25 +3521,28 @@ gimple_fold_builtin_sprintf (gimple_stmt_iterator *gsi) if (gimple_call_num_args (stmt) > 3) return false; + tree orig = NULL_TREE; if (gimple_call_num_args (stmt) == 3) orig = gimple_call_arg (stmt, 2); /* Check whether the format is a literal string constant. */ - fmt_str = c_getstr (fmt); + tree fmt = gimple_call_arg (stmt, 1); + const char *fmt_str = c_getstr (fmt); if (fmt_str == NULL) return false; + tree dest = gimple_call_arg (stmt, 0); + if (!init_target_chars ()) return false; + tree fn = builtin_decl_implicit (BUILT_IN_STRCPY); + if (!fn) + return false; + /* If the format doesn't contain % args or %%, use strcpy. */ if (strchr (fmt_str, target_percent) == NULL) { - tree fn = builtin_decl_implicit (BUILT_IN_STRCPY); - - if (!fn) - return false; - /* Don't optimize sprintf (buf, "abc", ptr++). */ if (orig) return false; @@ -3584,16 +3583,15 @@ gimple_fold_builtin_sprintf (gimple_stmt_iterator *gsi) /* If the format is "%s", use strcpy if the result isn't used. */ else if (fmt_str && strcmp (fmt_str, target_percent_s) == 0) { - tree fn; - fn = builtin_decl_implicit (BUILT_IN_STRCPY); - - if (!fn) - return false; - /* Don't crash on sprintf (str1, "%s"). */ if (!orig) return false; + /* Don't fold calls with source arguments of invalid (nonpointer) + types. */ + if (!POINTER_TYPE_P (TREE_TYPE (orig))) + return false; + tree orig_len = NULL_TREE; if (gimple_call_lhs (stmt)) { diff --git a/gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-11.c b/gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-11.c new file mode 100644 index 0000000..73117c4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-11.c @@ -0,0 +1,32 @@ +/* PR middle-end/100732 - ICE on sprintf %s with integer argument + { dg-do compile } + { dg-options "-O2 -Wall -fdump-tree-optimized" } */ + +char d[32]; + +void gb (_Bool b) +{ + __builtin_snprintf (d, 32, "%s", b); // { dg-warning "\\\[-Wformat" } +} + +void gi (int i) +{ + __builtin_snprintf (d, 32, "%s", i); // { dg-warning "\\\[-Wformat" } +} + +void gd (char *d, double x) +{ + __builtin_snprintf (d, 32, "%s", x); // { dg-warning "\\\[-Wformat" } +} + + +struct X { int i; }; + +void gx (char *d, struct X x) +{ + __builtin_snprintf (d, 32, "%s", x); // { dg-warning "\\\[-Wformat" } +} + +/* Also verify that the invalid sprintf call isn't folded to strcpy. + { dg-final { scan-tree-dump-times "snprintf" 4 "optimized" } } + { dg-final { scan-tree-dump-not "strcpy" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-12.c b/gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-12.c new file mode 100644 index 0000000..9e26356 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/builtin-snprintf-12.c @@ -0,0 +1,36 @@ +/* PR middle-end/100732 - ICE on sprintf %s with integer argument + { dg-do compile } + { dg-options "-O2 -Wall -fdump-tree-optimized" } */ + +#define snprintf(d, n, f, ...) \ + __builtin___snprintf_chk (d, n, 0, 32, f, __VA_ARGS__) + +int n; + +void gb (char *d, _Bool b) +{ + snprintf (d, n, "%s", b); // { dg-warning "\\\[-Wformat" } +} + +void gi (char *d, int i) +{ + snprintf (d, n, "%s", i); // { dg-warning "\\\[-Wformat" } +} + +void gd (char *d, double x) +{ + snprintf (d, n, "%s", x); // { dg-warning "\\\[-Wformat" } +} + + +struct X { int i; }; + +void gx (char *d, struct X x) +{ + snprintf (d, n, "%s", x); // { dg-warning "\\\[-Wformat" } +} + + +/* Also verify that the invalid sprintf call isn't folded to strcpy. + { dg-final { scan-tree-dump-times "snprintf_chk" 4 "optimized" } } + { dg-final { scan-tree-dump-not "strcpy" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-28.c b/gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-28.c new file mode 100644 index 0000000..c1d0083 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-28.c @@ -0,0 +1,30 @@ +/* PR middle-end/100732 - ICE on sprintf %s with integer argument + { dg-do compile } + { dg-options "-O2 -Wall -fdump-tree-optimized" } */ + +void gb (char *d, _Bool b) +{ + __builtin_sprintf (d, "%s", b); // { dg-warning "\\\[-Wformat" } +} + +void gi (char *d, int i) +{ + __builtin_sprintf (d, "%s", i); // { dg-warning "\\\[-Wformat" } +} + +void gd (char *d, double x) +{ + __builtin_sprintf (d, "%s", x); // { dg-warning "\\\[-Wformat" } +} + + +struct X { int i; }; + +void gx (char *d, struct X x) +{ + __builtin_sprintf (d, "%s", x); // { dg-warning "\\\[-Wformat" } +} + +/* Also verify that the invalid sprintf call isn't folded to strcpy. + { dg-final { scan-tree-dump-times "sprintf" 4 "optimized" } } + { dg-final { scan-tree-dump-not "strcpy" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-29.c b/gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-29.c new file mode 100644 index 0000000..d0f7db2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/builtin-sprintf-29.c @@ -0,0 +1,40 @@ +/* PR middle-end/100732 - ICE on sprintf %s with integer argument + { dg-do compile } + { dg-options "-O2 -Wall -fdump-tree-optimized" } */ + +#define sprintf(d, f, ...) \ + __builtin___sprintf_chk (d, 0, 32, f, __VA_ARGS__) + + +void fi (int i, const char *s) +{ + sprintf (i, "%s", s); // { dg-warning "\\\[-Wint-conversion" } +} + +void gb (char *d, _Bool b) +{ + sprintf (d, "%s", b); // { dg-warning "\\\[-Wformat" } +} + +void gi (char *d, int i) +{ + sprintf (d, "%s", i); // { dg-warning "\\\[-Wformat" } +} + +void gd (char *d, double x) +{ + sprintf (d, "%s", x); // { dg-warning "\\\[-Wformat" } +} + + +struct X { int i; }; + +void gx (char *d, struct X x) +{ + sprintf (d, "%s", x); // { dg-warning "\\\[-Wformat" } +} + + +/* Also verify that the invalid sprintf call isn't folded to strcpy. + { dg-final { scan-tree-dump-times "sprintf_chk" 5 "optimized" } } + { dg-final { scan-tree-dump-not "strcpy" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/uninit-pr100732.c b/gcc/testsuite/gcc.dg/uninit-pr100732.c new file mode 100644 index 0000000..9c847ce --- /dev/null +++ b/gcc/testsuite/gcc.dg/uninit-pr100732.c @@ -0,0 +1,21 @@ +/* PR middle-end/100732 - ICE on sprintf %s with integer argument + { dg-do compile } + { dg-options "-O2 -Wall -fdump-tree-optimized" } */ + +void nowarn_s_i (char *d, int i) +{ + __builtin_sprintf (d, "%s", i); // { dg-warning "\\\[-Wformat" } +} + +void warn_s_i (char *d) +{ + int i; + __builtin_sprintf (d, "%s", i); // { dg-warning "\\\[-Wformat" } + // { dg-warning "\\\[-Wuninitialized" "" { target *-*-* } .-1 } +} + +void warn_i_i (char *d) +{ + int i; + __builtin_sprintf (d, "%i", i); // { dg-warning "\\\[-Wuninitialized" } +} diff --git a/gcc/tree-ssa-uninit.c b/gcc/tree-ssa-uninit.c index dcfdec9..7c002f8 100644 --- a/gcc/tree-ssa-uninit.c +++ b/gcc/tree-ssa-uninit.c @@ -541,6 +541,9 @@ maybe_warn_pass_by_reference (gcall *stmt, wlimits &wlims) continue; tree arg = gimple_call_arg (stmt, argno - 1); + if (!POINTER_TYPE_P (TREE_TYPE (arg))) + /* Avoid actual arguments with invalid types. */ + continue; ao_ref ref; ao_ref_init_from_ptr_and_size (&ref, arg, access_size); -- cgit v1.1 From cb6e6d5faa3f817435b6f203226fa5969d7a7264 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 18:51:35 +0200 Subject: Fortran/OpenMP: Fix -fdump-parse-tree for 'omp loop' gcc/fortran/ChangeLog * dump-parse-tree.c (show_code_node): Handle EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP. --- gcc/fortran/dump-parse-tree.c | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gcc') diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 8e2df73..141101e 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -3214,6 +3214,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_FLUSH: + case EXEC_OMP_LOOP: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -3221,6 +3222,7 @@ show_code_node (int level, gfc_code *c) 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: @@ -3237,12 +3239,14 @@ show_code_node (int level, gfc_code *c) 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: @@ -3255,6 +3259,7 @@ show_code_node (int level, gfc_code *c) 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: show_omp_node (level, c); break; -- cgit v1.1 From 5328cad24f7460a39b2def12bb9b62be36c92a54 Mon Sep 17 00:00:00 2001 From: Martin Sebor Date: Fri, 4 Jun 2021 11:21:51 -0600 Subject: PR c/100783 - ICE on -Wnonnull and erroneous type gcc/c-family/ChangeLog: PR c/100783 * c-attribs.c (positional_argument): Bail on erroneous types. gcc/c/ChangeLog: PR c/100783 * c-objc-common.c (print_type): Handle erroneous types. gcc/testsuite/ChangeLog: PR c/100783 * gcc.dg/nonnull-6.c: New test. --- gcc/c-family/c-attribs.c | 3 +++ gcc/c/c-objc-common.c | 6 ++++++ gcc/testsuite/gcc.dg/nonnull-6.c | 15 +++++++++++++++ 3 files changed, 24 insertions(+) create mode 100644 gcc/testsuite/gcc.dg/nonnull-6.c (limited to 'gcc') diff --git a/gcc/c-family/c-attribs.c b/gcc/c-family/c-attribs.c index 156f7b3..42026a8 100644 --- a/gcc/c-family/c-attribs.c +++ b/gcc/c-family/c-attribs.c @@ -698,6 +698,9 @@ positional_argument (const_tree fntype, const_tree atname, tree pos, if (tree argtype = type_argument_type (fntype, ipos)) { + if (argtype == error_mark_node) + return NULL_TREE; + if (flags & POSARG_ELLIPSIS) { if (argno < 1) diff --git a/gcc/c/c-objc-common.c b/gcc/c/c-objc-common.c index a68249d..b945de1 100644 --- a/gcc/c/c-objc-common.c +++ b/gcc/c/c-objc-common.c @@ -185,6 +185,12 @@ get_aka_type (tree type) static void print_type (c_pretty_printer *cpp, tree t, bool *quoted) { + if (t == error_mark_node) + { + pp_string (cpp, _("{erroneous}")); + return; + } + gcc_assert (TYPE_P (t)); struct obstack *ob = pp_buffer (cpp)->obstack; char *p = (char *) obstack_base (ob); diff --git a/gcc/testsuite/gcc.dg/nonnull-6.c b/gcc/testsuite/gcc.dg/nonnull-6.c new file mode 100644 index 0000000..8f36870 --- /dev/null +++ b/gcc/testsuite/gcc.dg/nonnull-6.c @@ -0,0 +1,15 @@ +/* PR c/100783 - ICE on -Wnonnull and erroneous type + { dg-do compile } + { dg-options "-Wall" } */ + +__attribute__((nonnull (1))) void +f1 (char[][n]); // { dg-error "undeclared" } + +__attribute__((nonnull (2))) void +f2 (int n, char[n][m]); // { dg-error "undeclared" } + +__attribute__((nonnull (1))) void +f3 (char[*][n]); // { dg-error "undeclared" } + +__attribute__((nonnull (1))) void +f4 (char[f1]); // { dg-error "size" } -- cgit v1.1 From bee8619ad0ac3bd27b7c8dc5819b83a5e8e147a0 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 4 Jun 2021 19:23:48 +0200 Subject: Fortran - ICE in inline_matmul_assign Restrict inlining of matmul to those cases where assignment to the result array does not need special treatment. gcc/fortran/ChangeLog: PR fortran/99839 * frontend-passes.c (inline_matmul_assign): Do not inline matmul if the assignment to the resulting array if it is not of canonical type (real/integer/complex/logical). gcc/testsuite/ChangeLog: PR fortran/99839 * gfortran.dg/inline_matmul_25.f90: New test. --- gcc/fortran/frontend-passes.c | 13 +++++++++++++ gcc/testsuite/gfortran.dg/inline_matmul_25.f90 | 9 +++++++++ 2 files changed, 22 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/inline_matmul_25.f90 (limited to 'gcc') diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 34fb22c..72a4e04 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -4193,6 +4193,19 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, if (m_case == none) return 0; + /* We only handle assignment to numeric or logical variables. */ + switch(expr1->ts.type) + { + case BT_INTEGER: + case BT_LOGICAL: + case BT_REAL: + case BT_COMPLEX: + break; + + default: + return 0; + } + ns = insert_block (); /* Assign the type of the zero expression for initializing the resulting diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_25.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_25.f90 new file mode 100644 index 0000000..df8ad06 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inline_matmul_25.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! { dg-options "-ffrontend-optimize" } +! PR fortran/99839 - ICE in inline_matmul_assign + +program p + real :: x(3, 3) = 1.0 + class(*), allocatable :: z(:, :) + z = matmul(x, x) +end -- cgit v1.1 From 5357ab75dedef403b0eebf9277d61d1cbeb5898f Mon Sep 17 00:00:00 2001 From: Patrick Palka Date: Fri, 4 Jun 2021 13:46:53 -0400 Subject: c++: tsubst_function_decl and excess arg levels [PR100102] Here, when instantiating the dependent alias template duration::__is_harmonic with args={{T,U},{int}}, we find ourselves substituting the function decl _S_gcd. Since we have more arg levels than _S_gcd has parm levels, an old special case in tsubst_function_decl causes us to unwantedly reduce args to its innermost level, yielding args={int}, which leads to a nonsensical substitution into the decl context and eventually a crash. The comment for this special case refers to three examples for which we ought to see more arg levels than parm levels here, but none of the examples actually demonstrate this. In the first example, when defining S::f(U) parms_depth is 2 and args_depth is 1, and later when instantiating say S::f both depths are 2. In the second example, when substituting the template friend declaration parms_depth is 2 and args_depth is 1, and later when instantiating f both depths are 1. Finally, the third example is invalid since we can't specialize a member template of an unspecialized class template like that. Given that this reduction code seems no longer relevant for its documented purpose and that it causes problems as in the PR, this patch just removes it. Note that as far as bootstrap/regtest is concerned, this code is dead; the below two tests would be the first to reach it. PR c++/100102 gcc/cp/ChangeLog: * pt.c (tsubst_function_decl): Remove old code for reducing args when it has excess levels. gcc/testsuite/ChangeLog: * g++.dg/cpp0x/alias-decl-72.C: New test. * g++.dg/cpp0x/alias-decl-72a.C: New test. --- gcc/cp/pt.c | 39 ----------------------------- gcc/testsuite/g++.dg/cpp0x/alias-decl-72.C | 9 +++++++ gcc/testsuite/g++.dg/cpp0x/alias-decl-72a.C | 9 +++++++ 3 files changed, 18 insertions(+), 39 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp0x/alias-decl-72.C create mode 100644 gcc/testsuite/g++.dg/cpp0x/alias-decl-72a.C (limited to 'gcc') diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index 7211bdc..744461e 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -13905,45 +13905,6 @@ tsubst_function_decl (tree t, tree args, tsubst_flags_t complain, if (tree spec = retrieve_specialization (gen_tmpl, argvec, hash)) return spec; } - - /* We can see more levels of arguments than parameters if - there was a specialization of a member template, like - this: - - template struct S { template void f(); } - template <> template void S::f(U); - - Here, we'll be substituting into the specialization, - because that's where we can find the code we actually - want to generate, but we'll have enough arguments for - the most general template. - - We also deal with the peculiar case: - - template struct S { - template friend void f(); - }; - template void f() {} - template S; - template void f(); - - Here, the ARGS for the instantiation of will be {int, - double}. But, we only need as many ARGS as there are - levels of template parameters in CODE_PATTERN. We are - careful not to get fooled into reducing the ARGS in - situations like: - - template struct S { template void f(U); } - template template <> void S::f(int) {} - - which we can spot because the pattern will be a - specialization in this case. */ - int args_depth = TMPL_ARGS_DEPTH (args); - int parms_depth = - TMPL_PARMS_DEPTH (DECL_TEMPLATE_PARMS (DECL_TI_TEMPLATE (t))); - - if (args_depth > parms_depth && !DECL_TEMPLATE_SPECIALIZATION (t)) - args = get_innermost_template_args (args, parms_depth); } else { diff --git a/gcc/testsuite/g++.dg/cpp0x/alias-decl-72.C b/gcc/testsuite/g++.dg/cpp0x/alias-decl-72.C new file mode 100644 index 0000000..8009756 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/alias-decl-72.C @@ -0,0 +1,9 @@ +// PR c++/100102 +// { dg-do compile { target c++11 } } + +template struct ratio; +template struct duration { + static constexpr int _S_gcd(); + template using __is_harmonic = ratio<_S_gcd>; + using type = __is_harmonic; +}; diff --git a/gcc/testsuite/g++.dg/cpp0x/alias-decl-72a.C b/gcc/testsuite/g++.dg/cpp0x/alias-decl-72a.C new file mode 100644 index 0000000..a4443e1 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/alias-decl-72a.C @@ -0,0 +1,9 @@ +// PR c++/100102 +// { dg-do compile { target c++11 } } + +template struct ratio; +template struct duration { + static constexpr int _S_gcd(); + template using __is_harmonic = ratio<(duration::_S_gcd)()>; + using type = __is_harmonic; +}; -- cgit v1.1 From 6f8c9691495ad5a307db98dc19c3296ee4e6de64 Mon Sep 17 00:00:00 2001 From: Patrick Palka Date: Fri, 4 Jun 2021 14:08:26 -0400 Subject: c++: top-level cv-quals on type of NTTP [PR100893] Here, we're rejecting the specialization of g with T=A, F=&f in param4.C below due to a spurious constness mismatch between the type of the template argument &f and the substituted type of the parm F (the latter has a top-level const). Note that this mismatch doesn't occur with object pointers because in that case a call to perform_qualification_conversions from convert_nontype_argument implicitly adds a top-level const to the argument (via a cast) to match. This however seems to be a manifestation of a more general conformance issue: we're not dropping top-level cv-quals on the substituted type of an NTTP as per [temp.param]/6 (we only do so at parse time in process_template_parm). So this patch makes convert_template_argument drop top-level cv-quals accordingly. PR c++/100893 gcc/cp/ChangeLog: * pt.c (convert_template_argument): Strip top-level cv-quals on the substituted type of a non-type template parameter. gcc/testsuite/ChangeLog: * g++.dg/template/param4.C: New test. * g++.dg/template/param5.C: New test. * g++.dg/cpp1z/nontype-auto19.C: New test. * g++.dg/cpp2a/concepts-decltype.C: Don't expect that the deduced type of a decltype(auto) NTTP has top-level cv-quals. --- gcc/cp/pt.c | 4 ++++ gcc/testsuite/g++.dg/cpp1z/nontype-auto19.C | 8 ++++++++ gcc/testsuite/g++.dg/cpp2a/concepts-decltype.C | 2 +- gcc/testsuite/g++.dg/template/param4.C | 10 ++++++++++ gcc/testsuite/g++.dg/template/param5.C | 7 +++++++ 5 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/g++.dg/cpp1z/nontype-auto19.C create mode 100644 gcc/testsuite/g++.dg/template/param4.C create mode 100644 gcc/testsuite/g++.dg/template/param5.C (limited to 'gcc') diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index 744461e..2ae886d 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -8499,6 +8499,10 @@ convert_template_argument (tree parm, if (invalid_nontype_parm_type_p (t, complain)) return error_mark_node; + /* Drop top-level cv-qualifiers on the substituted/deduced type of + this non-type template parameter, as per [temp.param]/6. */ + t = cv_unqualified (t); + if (t != TREE_TYPE (parm)) t = canonicalize_type_argument (t, complain); diff --git a/gcc/testsuite/g++.dg/cpp1z/nontype-auto19.C b/gcc/testsuite/g++.dg/cpp1z/nontype-auto19.C new file mode 100644 index 0000000..d6b904f --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1z/nontype-auto19.C @@ -0,0 +1,8 @@ +// Verify top-level cv-qualifiers are dropped from the deduced +// type of a non-type template parameter, as per [temp.param]/6. +// { dg-do compile { target c++17 } } + +constexpr int x = 42; +template decltype(V)& f(); +using type = decltype(f()); +using type = int&; diff --git a/gcc/testsuite/g++.dg/cpp2a/concepts-decltype.C b/gcc/testsuite/g++.dg/cpp2a/concepts-decltype.C index 13733c6..b375f74 100644 --- a/gcc/testsuite/g++.dg/cpp2a/concepts-decltype.C +++ b/gcc/testsuite/g++.dg/cpp2a/concepts-decltype.C @@ -61,7 +61,7 @@ constexpr int Z = 10; static_assert(deduced_as<0, int>); static_assert(deduced_as<0, int&>); // { dg-error "invalid variable template" } -static_assert(deduced_as); +static_assert(deduced_as); static_assert(deduced_as<(Z), const int>); // { dg-error "invalid variable template" } static_assert(deduced_as<(Z), const int&>); diff --git a/gcc/testsuite/g++.dg/template/param4.C b/gcc/testsuite/g++.dg/template/param4.C new file mode 100644 index 0000000..8061ff7 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/param4.C @@ -0,0 +1,10 @@ +// PR c++/100893 + +template void g() { } + +struct A { typedef void (*const type)(); }; +void f(); +template void g(); + +struct B { typedef void (B::*const type)(); void f(); }; +template void g(); diff --git a/gcc/testsuite/g++.dg/template/param5.C b/gcc/testsuite/g++.dg/template/param5.C new file mode 100644 index 0000000..89a5c04 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/param5.C @@ -0,0 +1,7 @@ +// Verify top-level cv-qualifiers are dropped when determining the substituted +// type of a non-type template parameter, as per [temp.param]/6. +// { dg-do compile { target c++11 } } + +template decltype(V)& f(); +using type = decltype(f()); +using type = int&; -- cgit v1.1 From df3fbd5957f12927a459a2686f4eee55f66ec2f4 Mon Sep 17 00:00:00 2001 From: Iain Buclaw Date: Fri, 4 Jun 2021 19:38:26 +0200 Subject: d: Fix ICE in gimplify_var_or_parm_decl, at gimplify.c:2755 (PR100882) Constructor calls for temporaries were reusing the TARGET_EXPR_SLOT of a TARGET_EXPR for an assignment, which later got passed to `build_assign', which stripped away the outer TARGET_EXPR, leaving a reference to a lone temporary with no declaration. This stripping away of the TARGET_EXPR also discarded any cleanups that may have been assigned to the expression as well. So now the reuse of TARGET_EXPR_SLOT has been removed, and `build_assign' now constructs assignments inside the TARGET_EXPR_INITIAL slot. This has also been extended to `return_expr', to deal with possibility of a TARGET_EXPR being returned. gcc/d/ChangeLog: PR d/100882 * d-codegen.cc (build_assign): Construct initializations inside TARGET_EXPR_INITIAL. (compound_expr): Remove intermediate expressions that have no side-effects. (return_expr): Construct returns inside TARGET_EXPR_INITIAL. * expr.cc (ExprVisitor::visit (CallExp *)): Remove useless assignment to TARGET_EXPR_SLOT. gcc/testsuite/ChangeLog: PR d/100882 * gdc.dg/pr100882a.d: New test. * gdc.dg/pr100882b.d: New test. * gdc.dg/pr100882c.d: New test. * gdc.dg/torture/pr100882.d: New test. --- gcc/d/d-codegen.cc | 36 +++++++++++++++++++++++++++------ gcc/d/expr.cc | 7 +------ gcc/testsuite/gdc.dg/pr100882a.d | 35 ++++++++++++++++++++++++++++++++ gcc/testsuite/gdc.dg/pr100882b.d | 19 +++++++++++++++++ gcc/testsuite/gdc.dg/pr100882c.d | 25 +++++++++++++++++++++++ gcc/testsuite/gdc.dg/torture/pr100882.d | 21 +++++++++++++++++++ 6 files changed, 131 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gdc.dg/pr100882a.d create mode 100644 gcc/testsuite/gdc.dg/pr100882b.d create mode 100644 gcc/testsuite/gdc.dg/pr100882c.d create mode 100644 gcc/testsuite/gdc.dg/torture/pr100882.d (limited to 'gcc') diff --git a/gcc/d/d-codegen.cc b/gcc/d/d-codegen.cc index 5fa1acd..9a94473 100644 --- a/gcc/d/d-codegen.cc +++ b/gcc/d/d-codegen.cc @@ -1330,6 +1330,7 @@ component_ref (tree object, tree field) tree build_assign (tree_code code, tree lhs, tree rhs) { + tree result; tree init = stabilize_expr (&lhs); init = compound_expr (init, stabilize_expr (&rhs)); @@ -1348,22 +1349,27 @@ build_assign (tree_code code, tree lhs, tree rhs) if (TREE_CODE (rhs) == TARGET_EXPR) { /* If CODE is not INIT_EXPR, can't initialize LHS directly, - since that would cause the LHS to be constructed twice. - So we force the TARGET_EXPR to be expanded without a target. */ + since that would cause the LHS to be constructed twice. */ if (code != INIT_EXPR) { init = compound_expr (init, rhs); - rhs = TARGET_EXPR_SLOT (rhs); + result = build_assign (code, lhs, TARGET_EXPR_SLOT (rhs)); } else { d_mark_addressable (lhs); - rhs = TARGET_EXPR_INITIAL (rhs); + TARGET_EXPR_INITIAL (rhs) = build_assign (code, lhs, + TARGET_EXPR_INITIAL (rhs)); + result = rhs; } } + else + { + /* Simple assignment. */ + result = fold_build2_loc (input_location, code, + TREE_TYPE (lhs), lhs, rhs); + } - tree result = fold_build2_loc (input_location, code, - TREE_TYPE (lhs), lhs, rhs); return compound_expr (init, result); } @@ -1485,6 +1491,11 @@ compound_expr (tree arg0, tree arg1) if (arg0 == NULL_TREE || !TREE_SIDE_EFFECTS (arg0)) return arg1; + /* Remove intermediate expressions that have no side-effects. */ + while (TREE_CODE (arg0) == COMPOUND_EXPR + && !TREE_SIDE_EFFECTS (TREE_OPERAND (arg0, 1))) + arg0 = TREE_OPERAND (arg0, 0); + if (TREE_CODE (arg1) == TARGET_EXPR) { /* If the rhs is a TARGET_EXPR, then build the compound expression @@ -1505,6 +1516,19 @@ compound_expr (tree arg0, tree arg1) tree return_expr (tree ret) { + /* Same as build_assign, the DECL_RESULT assignment replaces the temporary + in TARGET_EXPR_SLOT. */ + if (ret != NULL_TREE && TREE_CODE (ret) == TARGET_EXPR) + { + tree exp = TARGET_EXPR_INITIAL (ret); + tree init = stabilize_expr (&exp); + + exp = fold_build1_loc (input_location, RETURN_EXPR, void_type_node, exp); + TARGET_EXPR_INITIAL (ret) = compound_expr (init, exp); + + return ret; + } + return fold_build1_loc (input_location, RETURN_EXPR, void_type_node, ret); } diff --git a/gcc/d/expr.cc b/gcc/d/expr.cc index aad7cbb..e76cae9 100644 --- a/gcc/d/expr.cc +++ b/gcc/d/expr.cc @@ -1894,15 +1894,10 @@ public: exp = d_convert (build_ctype (e->type), exp); /* If this call was found to be a constructor for a temporary with a - cleanup, then move the call inside the TARGET_EXPR. The original - initializer is turned into an assignment, to keep its side effect. */ + cleanup, then move the call inside the TARGET_EXPR. */ if (cleanup != NULL_TREE) { tree init = TARGET_EXPR_INITIAL (cleanup); - tree slot = TARGET_EXPR_SLOT (cleanup); - d_mark_addressable (slot); - init = build_assign (INIT_EXPR, slot, init); - TARGET_EXPR_INITIAL (cleanup) = compound_expr (init, exp); exp = cleanup; } diff --git a/gcc/testsuite/gdc.dg/pr100882a.d b/gcc/testsuite/gdc.dg/pr100882a.d new file mode 100644 index 0000000..de92ab3 --- /dev/null +++ b/gcc/testsuite/gdc.dg/pr100882a.d @@ -0,0 +1,35 @@ +// https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100882 +// { dg-do compile } + +struct AllocatorList(Factory) +{ + Factory factory; + auto make(size_t n) { return factory(n); } + this(Factory plant) + { + factory = plant; + } +} + +struct Region +{ + ~this() + { + } +} + +auto mmapRegionList() +{ + struct Factory + { + this(size_t ) + { + } + auto opCall(size_t ) + { + return Region(); + } + } + auto shop = Factory(); + AllocatorList!Factory(shop); +} diff --git a/gcc/testsuite/gdc.dg/pr100882b.d b/gcc/testsuite/gdc.dg/pr100882b.d new file mode 100644 index 0000000..deaa4b4 --- /dev/null +++ b/gcc/testsuite/gdc.dg/pr100882b.d @@ -0,0 +1,19 @@ +// https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100882 +// { dg-do compile } + +auto iota(int, int) +{ + struct Result + { + this(int) + { + } + } + return Result(); +} + +auto iota(int end) +{ + int begin; + return iota(begin, end); +} diff --git a/gcc/testsuite/gdc.dg/pr100882c.d b/gcc/testsuite/gdc.dg/pr100882c.d new file mode 100644 index 0000000..f4e6e4d --- /dev/null +++ b/gcc/testsuite/gdc.dg/pr100882c.d @@ -0,0 +1,25 @@ +// https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100882 +// { dg-do compile } + +struct CowArray +{ + this(this) + { + } +} + +struct Tuple +{ + CowArray expand; +} + +auto tuple(CowArray) +{ + return Tuple(); +} + +auto parseCharTerm() +{ + CowArray set; + return tuple(set); +} diff --git a/gcc/testsuite/gdc.dg/torture/pr100882.d b/gcc/testsuite/gdc.dg/torture/pr100882.d new file mode 100644 index 0000000..d94baff --- /dev/null +++ b/gcc/testsuite/gdc.dg/torture/pr100882.d @@ -0,0 +1,21 @@ +// https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100882 +// { dg-additional-options "-fmain" } +// { dg-do run } + +__gshared int counter = 0; +struct S100882 +{ + this(int) { counter++; } + ~this() { counter++; } +} +static S100882 s; +static this() +{ + s = cast(shared) S100882(0); + assert(counter == 2); +} + +auto test100882() +{ + return cast(shared) S100882(0); +} -- cgit v1.1 From c7070b31e12c18905ed0a60aaedd7a071aab5c60 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 20:52:33 +0200 Subject: OpenMP: Handle bind clause in tree-nested.c [PR100905] PR middle-end/100905 gcc/ChangeLog: * tree-nested.c (convert_nonlocal_omp_clauses, convert_local_omp_clauses): Handle OMP_CLAUSE_BIND. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/loop-3.f90: New test. --- gcc/testsuite/gfortran.dg/gomp/loop-3.f90 | 55 +++++++++++++++++++++++++++++++ gcc/tree-nested.c | 2 ++ 2 files changed, 57 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/gomp/loop-3.f90 (limited to 'gcc') diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-3.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-3.f90 new file mode 100644 index 0000000..6d25b19 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/loop-3.f90 @@ -0,0 +1,55 @@ +! PR middle-end/100905 +! +PROGRAM test_loop_order_concurrent + implicit none + integer :: a, cc(64), dd(64) + + dd = 54 + cc = 99 + + call test_loop() + call test_affinity(a) + if (a /= 5) stop 3 + call test_scan(cc, dd) + if (any (cc /= 99)) stop 4 + if (dd(1) /= 5 .or. dd(2) /= 104) stop 5 + +CONTAINS + + SUBROUTINE test_loop() + INTEGER,DIMENSION(1024):: a, b, c + INTEGER:: i + + DO i = 1, 1024 + a(i) = 1 + b(i) = i + 1 + c(i) = 2*(i + 1) + END DO + + !$omp loop order(concurrent) bind(thread) + DO i = 1, 1024 + a(i) = a(i) + b(i)*c(i) + END DO + + DO i = 1, 1024 + if (a(i) /= 1 + (b(i)*c(i))) stop 1 + END DO + END SUBROUTINE test_loop + + SUBROUTINE test_affinity(aa) + integer :: aa + !$omp task affinity(aa) + a = 5 + !$omp end task + end + + subroutine test_scan(c, d) + integer i, c(*), d(*) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + end +END PROGRAM test_loop_order_concurrent diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c index cea917a..41cbca9 100644 --- a/gcc/tree-nested.c +++ b/gcc/tree-nested.c @@ -1484,6 +1484,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_AUTO: case OMP_CLAUSE_IF_PRESENT: case OMP_CLAUSE_FINALIZE: + case OMP_CLAUSE_BIND: case OMP_CLAUSE__CONDTEMP_: case OMP_CLAUSE__SCANTEMP_: break; @@ -2264,6 +2265,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_AUTO: case OMP_CLAUSE_IF_PRESENT: case OMP_CLAUSE_FINALIZE: + case OMP_CLAUSE_BIND: case OMP_CLAUSE__CONDTEMP_: case OMP_CLAUSE__SCANTEMP_: break; -- cgit v1.1 From 600f90cbbbf2f1e4511d72a23a5d637d11e9f28b Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sat, 5 Jun 2021 00:16:29 +0000 Subject: Daily bump. --- gcc/ChangeLog | 78 ++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/c-family/ChangeLog | 10 ++++ gcc/c/ChangeLog | 5 ++ gcc/cp/ChangeLog | 19 ++++++++ gcc/d/ChangeLog | 11 +++++ gcc/fortran/ChangeLog | 59 ++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 118 ++++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 301 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 06e6dbe..e94b2fc 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,81 @@ +2021-06-04 Tobias Burnus + + PR middle-end/100905 + * tree-nested.c (convert_nonlocal_omp_clauses, + convert_local_omp_clauses): Handle OMP_CLAUSE_BIND. + +2021-06-04 Martin Sebor + + PR middle-end/100732 + * gimple-fold.c (gimple_fold_builtin_sprintf): Avoid folding calls + with either source or destination argument of invalid type. + * tree-ssa-uninit.c (maybe_warn_pass_by_reference): Avoid checking + calls with arguments of invalid type. + +2021-06-04 Martin Sebor + + * attribs.c (init_attr_rdwr_indices): Use VLA bounds in the expected + order. + (attr_access::vla_bounds): Also handle VLA bounds. + +2021-06-04 Uroš Bizjak + + * config/i386/predicates.md (GOT_memory_operand): + Implement using match_code RTXes. + (GOT32_symbol_operand): Ditto. + +2021-06-04 Uroš Bizjak + + PR target/100637 + * config/i386/i386-expand.c (ix86_expand_vector_init_duplicate): + Handle V2HI mode. + (ix86_expand_vector_init_general): Ditto. + Use SImode instead of word_mode for logic operations + when GET_MODE_SIZE (mode) < UNITS_PER_WORD. + (expand_vec_perm_even_odd_1): Assert that V2HI mode should be + implemented by expand_vec_perm_1. + (expand_vec_perm_broadcast_1): Assert that V2HI and V4HI modes + should be implemented using standard shuffle patterns. + (ix86_vectorize_vec_perm_const): Handle V2HImode. Add V4HI and + V2HI modes to modes, implementable with shuffle for one operand. + * config/i386/mmx.md (*punpckwd): New insn_and_split pattern. + (*pshufw_1): New insn pattern. + (*vec_dupv2hi): Ditto. + (vec_initv2hihi): New expander. + +2021-06-04 Kewen Lin + + * config/arm/vfp.md (no_literal_pool_df_immediate, + no_literal_pool_sf_immediate): Fix empty split condition. + +2021-06-04 Kewen Lin + + * config/i386/i386.md (*load_tp_x32_zext, *add_tp_x32_zext, + *tls_dynamic_gnu2_combine_32): Fix empty split condition. + * config/i386/sse.md (*_pmovmskb_lt, + *_pmovmskb_zext_lt, *sse2_pmovmskb_ext_lt, + *_pblendvb_lt): Likewise. + +2021-06-04 Jakub Jelinek + + PR target/100887 + * config/i386/i386-expand.c (ix86_expand_vector_init): Handle + concatenation from half-sized modes with TImode elements. + +2021-06-04 Claudiu Zissulescu + + * config/arc/arc.c (arc_override_options): Disable millicode + thunks when RF16 is on. + +2021-06-04 Haochen Gui + + * config/rs6000/rs6000.h (PROMOTE_MODE): Remove. + +2021-06-04 Haochen Gui + + * config/rs6000/rs6000-call.c (rs6000_promote_function_mode): + Replace PROMOTE_MODE marco with its content. + 2021-06-03 Kewen Lin * config/cris/cris.md (*addi_reload): Fix empty split condition. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 8da0c6d..0098130 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20210604 +20210605 diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 968322f..3938ef1 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,13 @@ +2021-06-04 Martin Sebor + + PR c/100783 + * c-attribs.c (positional_argument): Bail on erroneous types. + +2021-06-04 Martin Sebor + + * c-warn.c (warn_parm_array_mismatch): Check TREE_PURPOSE to test + for element presence. + 2021-06-03 Eric Botcazou * c-ada-spec.c (dump_ada_macros): Minor tweaks. diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index 3a7e3d4..747f53f 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,8 @@ +2021-06-04 Martin Sebor + + PR c/100783 + * c-objc-common.c (print_type): Handle erroneous types. + 2021-06-03 Jakub Jelinek PR c++/100859 diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 6c0f38c..f1537e5 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,22 @@ +2021-06-04 Patrick Palka + + PR c++/100893 + * pt.c (convert_template_argument): Strip top-level cv-quals + on the substituted type of a non-type template parameter. + +2021-06-04 Patrick Palka + + PR c++/100102 + * pt.c (tsubst_function_decl): Remove old code for reducing + args when it has excess levels. + +2021-06-04 Jakub Jelinek + + PR c++/100872 + * name-lookup.c (maybe_save_operator_binding): Add op_attr after all + ATTR_IS_DEPENDENT attributes in the DECL_ATTRIBUTES list rather than + to the start. + 2021-06-03 Patrick Palka PR c++/100592 diff --git a/gcc/d/ChangeLog b/gcc/d/ChangeLog index 85176b7..4e9a396 100644 --- a/gcc/d/ChangeLog +++ b/gcc/d/ChangeLog @@ -1,3 +1,14 @@ +2021-06-04 Iain Buclaw + + PR d/100882 + * d-codegen.cc (build_assign): Construct initializations inside + TARGET_EXPR_INITIAL. + (compound_expr): Remove intermediate expressions that have no + side-effects. + (return_expr): Construct returns inside TARGET_EXPR_INITIAL. + * expr.cc (ExprVisitor::visit (CallExp *)): Remove useless assignment + to TARGET_EXPR_SLOT. + 2021-05-18 Iain Buclaw * d-incpath.cc (prefixed_path): Use filename_ncmp instead of strncmp. diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bab25eb..33ab58a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,62 @@ +2021-06-04 Harald Anlauf + + PR fortran/99839 + * frontend-passes.c (inline_matmul_assign): Do not inline matmul + if the assignment to the resulting array if it is not of canonical + type (real/integer/complex/logical). + +2021-06-04 Tobias Burnus + + * dump-parse-tree.c (show_code_node): Handle + EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP. + +2021-06-04 Tobias Burnus + + * scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if + this is not an (OpenMP) continuation line. + (skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC. + (gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC + continuation once per location and return '\n'. + +2021-06-04 Tobias Burnus + + PR middle-end/99928 + * openmp.c (gfc_match_omp_clauses): Fix typo in error message. + +2021-06-04 Tobias Burnus + + PR middle-end/99928 + * 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. + 2021-06-01 Tobias Burnus PR middle-end/99928 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ac63a14..ba1d2c7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,121 @@ +2021-06-04 Tobias Burnus + + PR middle-end/100905 + * gfortran.dg/gomp/loop-3.f90: New test. + +2021-06-04 Iain Buclaw + + PR d/100882 + * gdc.dg/pr100882a.d: New test. + * gdc.dg/pr100882b.d: New test. + * gdc.dg/pr100882c.d: New test. + * gdc.dg/torture/pr100882.d: New test. + +2021-06-04 Patrick Palka + + PR c++/100893 + * g++.dg/template/param4.C: New test. + * g++.dg/template/param5.C: New test. + * g++.dg/cpp1z/nontype-auto19.C: New test. + * g++.dg/cpp2a/concepts-decltype.C: Don't expect that the + deduced type of a decltype(auto) NTTP has top-level cv-quals. + +2021-06-04 Patrick Palka + + PR c++/100102 + * g++.dg/cpp0x/alias-decl-72.C: New test. + * g++.dg/cpp0x/alias-decl-72a.C: New test. + +2021-06-04 Harald Anlauf + + PR fortran/99839 + * gfortran.dg/inline_matmul_25.f90: New test. + +2021-06-04 Martin Sebor + + PR c/100783 + * gcc.dg/nonnull-6.c: New test. + +2021-06-04 Martin Sebor + + PR middle-end/100732 + * gcc.dg/tree-ssa/builtin-snprintf-11.c: New test. + * gcc.dg/tree-ssa/builtin-snprintf-12.c: New test. + * gcc.dg/tree-ssa/builtin-sprintf-28.c: New test. + * gcc.dg/tree-ssa/builtin-sprintf-29.c: New test. + * gcc.dg/uninit-pr100732.c: New test. + +2021-06-04 Martin Sebor + + * gcc.dg/Wvla-parameter-10.c: New test. + * gcc.dg/Wvla-parameter-11.c: New test. + +2021-06-04 Tobias Burnus + + * gfortran.dg/goacc/omp-fixed.f: Re-add test item changed in previous + commit in addition - add more dg-errors and '... end ...' due to changed + parsing. + * gfortran.dg/goacc/omp.f95: Likewise. + * gfortran.dg/goacc-gomp/mixed-1.f: New test. + +2021-06-04 Uroš Bizjak + + PR target/100637 + * gcc.dg/vect/slp-perm-9.c (dg-final): Adjust dumps for vect32 targets. + +2021-06-04 Tobias Burnus + + * gfortran.dg/gomp/pr99928-5.f90: Really use the + proper iteration variable. + +2021-06-04 Tobias Burnus + + * gfortran.dg/gomp/pr99928-1.f90: Add 'implicit none'. + * gfortran.dg/gomp/pr99928-11.f90: Likewise. + * gfortran.dg/gomp/pr99928-4.f90: Likewise. + * gfortran.dg/gomp/pr99928-6.f90: Likewise. + * gfortran.dg/gomp/pr99928-8.f90: Likewise. + * gfortran.dg/gomp/pr99928-2.f90: Likewise. Add missing decl. + * gfortran.dg/gomp/pr99928-5.f90: Add implicit none; + fix loop-variable and remove xfail. + +2021-06-04 Tobias Burnus + + PR middle-end/99928 + * gfortran.dg/gomp/loop-2.f90: Update for typo fix. + +2021-06-04 Tobias Burnus + + PR middle-end/99928 + * 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 + +2021-06-04 Jakub Jelinek + + PR target/100887 + * gcc.target/i386/pr100887.c: New test. + +2021-06-04 Jakub Jelinek + + PR c++/100872 + * g++.dg/gomp/declare-simd-8.C: New test. + +2021-06-04 Haochen Gui + + * gcc.target/powerpc/not-promote-mode.c: New. + 2021-06-03 Uroš Bizjak PR target/100637 -- cgit v1.1 From 549d7f4310f6f8c2c64efcb6f3efcee99c9d9f4f Mon Sep 17 00:00:00 2001 From: Jeff Law Date: Sat, 5 Jun 2021 01:27:02 -0400 Subject: Fix split conditions in H8/300 port gcc/ * config/h8300/addsub.md: Fix split condition in define_insn_and_split patterns. * config/h8300/bitfield.md: Likewise. * config/h8300/combiner.md: Likewise. * config/h8300/divmod.md: Likewise. * config/h8300/extensions.md: Likewise. * config/h8300/jumpcall.md: Likewise. * config/h8300/movepush.md: Likewise. * config/h8300/multiply.md: Likewise. * config/h8300/other.md: Likewise. * config/h8300/shiftrotate.md: Likewise. * config/h8300/logical.md: Likewise. Fix split pattern to use code iterator that somehow slipped through. --- gcc/config/h8300/addsub.md | 16 +++++----- gcc/config/h8300/bitfield.md | 16 +++++----- gcc/config/h8300/combiner.md | 68 ++++++++++++++++++++--------------------- gcc/config/h8300/divmod.md | 12 ++++---- gcc/config/h8300/extensions.md | 12 ++++---- gcc/config/h8300/jumpcall.md | 2 +- gcc/config/h8300/logical.md | 2 +- gcc/config/h8300/movepush.md | 22 ++++++------- gcc/config/h8300/multiply.md | 12 ++++---- gcc/config/h8300/other.md | 2 +- gcc/config/h8300/shiftrotate.md | 18 +++++------ 11 files changed, 91 insertions(+), 91 deletions(-) (limited to 'gcc') diff --git a/gcc/config/h8300/addsub.md b/gcc/config/h8300/addsub.md index 3585bff..b1eb0d2 100644 --- a/gcc/config/h8300/addsub.md +++ b/gcc/config/h8300/addsub.md @@ -15,7 +15,7 @@ (match_operand:QI 2 "h8300_src_operand" "rQi")))] "h8300_operands_match_p (operands)" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (plus:QI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -34,7 +34,7 @@ (match_operand:HI 2 "h8300_src_operand" "L,N,J,n,r")))] "!TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (plus:HI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -81,7 +81,7 @@ (match_operand:HI 2 "h8300_src_operand" "P3>X,P3"))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (match_dup 1) (const_int -256)) (zero_extend:SI (match_dup 2)))) @@ -758,7 +758,7 @@ (match_operand:SI 2 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (ashift:SI (match_dup 1) (const_int 31)) (match_dup 2))) @@ -782,7 +782,7 @@ (match_operand:SI 4 "register_operand" "0")))] "(INTVAL (operands[3]) & ~0xffff) == 0" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (ashift:SI (match_dup 1) (match_dup 2)) (match_dup 3)) @@ -815,7 +815,7 @@ (match_operand:SI 4 "register_operand" "0")))] "((INTVAL (operands[3]) << INTVAL (operands[2])) & ~0xffff) == 0" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (lshiftrt:SI (match_dup 1) (match_dup 2)) (match_dup 3)) @@ -848,7 +848,7 @@ (match_operand:SI 3 "register_operand" "0")))] "INTVAL (operands[2]) < 16" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (zero_extract:SI (match_dup 1) (const_int 1) @@ -875,7 +875,7 @@ (match_operand:SI 2 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (lshiftrt:SI (match_dup 1) (const_int 30)) (const_int 2)) @@ -902,7 +902,7 @@ (clobber (match_scratch:HI 3 "=&r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (lshiftrt:SI (match_dup 1) (const_int 9)) (const_int 4194304)) @@ -993,7 +993,7 @@ (const_int 1))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (match_dup 1) (const_int 1)) (lshiftrt:SI (match_dup 1) (const_int 1)))) @@ -1147,7 +1147,7 @@ (const_int 8)) 1))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (subreg:QI (lshiftrt:HI (match_dup 1) (const_int 8)) 1)) (clobber (reg:CC CC_REG))])]) @@ -1169,7 +1169,7 @@ (const_int 8)) 3))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (subreg:QI (lshiftrt:SI (match_dup 1) (const_int 8)) 3)) (clobber (reg:CC CC_REG))])]) @@ -1190,7 +1190,7 @@ (clobber (match_scratch:SI 2 "=&r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (subreg:QI (lshiftrt:SI (match_dup 1) (const_int 16)) 3)) (clobber (match_dup 2)) @@ -1213,7 +1213,7 @@ (clobber (match_scratch:SI 2 "=&r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (subreg:QI (lshiftrt:SI (match_dup 1) (const_int 24)) 3)) (clobber (match_dup 2)) diff --git a/gcc/config/h8300/divmod.md b/gcc/config/h8300/divmod.md index b5ab6b7..67f253c 100644 --- a/gcc/config/h8300/divmod.md +++ b/gcc/config/h8300/divmod.md @@ -8,7 +8,7 @@ (match_operand:HSI 2 "reg_or_nibble_operand" "r IP4>X")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (udiv:HSI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -27,7 +27,7 @@ (match_operand:HSI 2 "reg_or_nibble_operand" "r IP4>X")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (div:HSI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -53,7 +53,7 @@ (zero_extend:HI (match_dup 2)))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (truncate:QI (udiv:HI (match_dup 1) (zero_extend:HI (match_dup 2))))) @@ -97,7 +97,7 @@ (sign_extend:HI (match_dup 2)))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (truncate:QI (div:HI (match_dup 1) (sign_extend:HI (match_dup 2))))) @@ -140,7 +140,7 @@ (zero_extend:SI (match_dup 2)))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (truncate:HI (udiv:SI (match_dup 1) (zero_extend:SI (match_dup 2))))) @@ -183,7 +183,7 @@ (sign_extend:SI (match_dup 2)))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (truncate:HI (div:SI (match_dup 1) (sign_extend:SI (match_dup 2))))) diff --git a/gcc/config/h8300/extensions.md b/gcc/config/h8300/extensions.md index 7631230..bc10179 100644 --- a/gcc/config/h8300/extensions.md +++ b/gcc/config/h8300/extensions.md @@ -16,7 +16,7 @@ (zero_extend:HI (match_operand:QI 1 "general_operand_src" "0,g>")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extend:HI (match_dup 1))) (clobber (reg:CC CC_REG))])]) @@ -91,7 +91,7 @@ (zero_extend:SI (match_operand:QI 1 "register_operand" "0")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extend:SI (match_dup 1))) (clobber (reg:CC CC_REG))])]) @@ -114,7 +114,7 @@ (zero_extend:SI (match_operand:HI 1 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extend:SI (match_dup 1))) (clobber (reg:CC CC_REG))])]) @@ -137,7 +137,7 @@ (sign_extend:HI (match_operand:QI 1 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (sign_extend:HI (match_dup 1))) (clobber (reg:CC CC_REG))])]) @@ -172,7 +172,7 @@ (sign_extend:SI (match_operand:QI 1 "register_operand" "0")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (sign_extend:SI (match_dup 1))) (clobber (reg:CC CC_REG))])]) @@ -195,7 +195,7 @@ (sign_extend:SI (match_operand:HI 1 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (sign_extend:SI (match_dup 1))) (clobber (reg:CC CC_REG))])]) diff --git a/gcc/config/h8300/jumpcall.md b/gcc/config/h8300/jumpcall.md index 49d1e43..7b6a66a 100644 --- a/gcc/config/h8300/jumpcall.md +++ b/gcc/config/h8300/jumpcall.md @@ -22,7 +22,7 @@ (pc)))] "" "#" - "reload_completed" + "&& reload_completed" [(set (reg:H8cc CC_REG) (compare:H8cc (match_dup 1) (match_dup 2))) (set (pc) diff --git a/gcc/config/h8300/logical.md b/gcc/config/h8300/logical.md index d778d24..34cf74e 100644 --- a/gcc/config/h8300/logical.md +++ b/gcc/config/h8300/logical.md @@ -223,7 +223,7 @@ "#" "&& reload_completed" [(parallel [(set (match_dup 0) - (match_op_dup 3 [(match_dup 1) (match_dup 2)])) + (logicals:QHSI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) (define_insn "*3_clobber_flags" diff --git a/gcc/config/h8300/movepush.md b/gcc/config/h8300/movepush.md index b106cd5..9ce00fb 100644 --- a/gcc/config/h8300/movepush.md +++ b/gcc/config/h8300/movepush.md @@ -9,7 +9,7 @@ (match_operand:QI 1 "general_operand_src" " I,r>,r,n,m,r"))] "!TARGET_H8300SX && h8300_move_ok (operands[0], operands[1])" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -32,7 +32,7 @@ (match_operand:QI 1 "general_operand_src" "P4>X,rQi"))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -69,7 +69,7 @@ (match_operand:QI 1 "general_operand_src" "I,rmi>"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (strict_low_part (match_dup 0)) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -93,7 +93,7 @@ "!TARGET_H8300SX && h8300_move_ok (operands[0], operands[1])" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -117,7 +117,7 @@ (match_operand:HI 1 "general_operand_src" "I,P3>X,P4>X,IP8>X,rQi"))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -140,7 +140,7 @@ (match_operand:HI 1 "general_operand_src" "I,P3>X,rmi"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (strict_low_part (match_dup 0)) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -163,7 +163,7 @@ "(TARGET_H8300S || TARGET_H8300H) && !TARGET_H8300SX && h8300_move_ok (operands[0], operands[1])" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -240,7 +240,7 @@ (match_operand:SI 1 "general_operand_src" "I,P3>X,IP8>X,rQi,I,r,*a"))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -265,7 +265,7 @@ (match_operand:SF 1 "general_operand_src" "G,rQi"))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -287,7 +287,7 @@ && (register_operand (operands[0], SFmode) || register_operand (operands[1], SFmode))" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -319,7 +319,7 @@ (match_operand:QHI 0 "register_no_sp_elim_operand" "r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (mem:QHI (pre_modify:P (reg:P SP_REG) (plus:P (reg:P SP_REG) (const_int -4)))) diff --git a/gcc/config/h8300/multiply.md b/gcc/config/h8300/multiply.md index 56f2b6f..1d56d47 100644 --- a/gcc/config/h8300/multiply.md +++ b/gcc/config/h8300/multiply.md @@ -21,7 +21,7 @@ (match_operand:QI 2 "nibble_operand" "IP4>X")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (mult:HI (sign_extend:HI (match_dup 1)) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -41,7 +41,7 @@ (sign_extend:HI (match_operand:QI 2 "register_operand" "r"))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (mult:HI (sign_extend:HI (match_dup 1)) (sign_extend:HI (match_dup 2)))) @@ -73,7 +73,7 @@ (match_operand:SI 2 "nibble_operand" "IP4>X")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (mult:SI (sign_extend:SI (match_dup 1)) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -93,7 +93,7 @@ (sign_extend:SI (match_operand:HI 2 "register_operand" "r"))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (mult:SI (sign_extend:SI (match_dup 1)) (sign_extend:SI (match_dup 2)))) @@ -172,7 +172,7 @@ (match_operand:HSI 2 "reg_or_nibble_operand" "r IP4>X")))] "TARGET_H8300SX" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (mult:HSI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -195,7 +195,7 @@ (const_int 32))))] "TARGET_H8300SXMUL" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (truncate:SI (lshiftrt:DI (mult:DI (sign_extend:DI (match_dup 1)) diff --git a/gcc/config/h8300/other.md b/gcc/config/h8300/other.md index 572a29f..c754227 100644 --- a/gcc/config/h8300/other.md +++ b/gcc/config/h8300/other.md @@ -7,7 +7,7 @@ (abs:SF (match_operand:SF 1 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (abs:SF (match_dup 1))) (clobber (reg:CC CC_REG))])]) diff --git a/gcc/config/h8300/shiftrotate.md b/gcc/config/h8300/shiftrotate.md index 4bf8fe1..23140d9a 100644 --- a/gcc/config/h8300/shiftrotate.md +++ b/gcc/config/h8300/shiftrotate.md @@ -57,7 +57,7 @@ (match_operand:QI 2 "const_int_operand" "")]))] "h8300_operands_match_p (operands)" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (reg:CC CC_REG))])]) @@ -107,7 +107,7 @@ (match_operand:QI 2 "nonmemory_operand" "r P5>X")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (reg:CC CC_REG))])]) @@ -158,7 +158,7 @@ (clobber (match_scratch:QI 4 "=X,&r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (match_dup 4)) (clobber (reg:CC CC_REG))])]) @@ -186,7 +186,7 @@ && !h8300_shift_needs_scratch_p (INTVAL (operands[2]), QImode, GET_CODE (operands[3])))" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (reg:CC CC_REG))])]) @@ -213,7 +213,7 @@ (clobber (match_scratch:QI 4 "=X,&r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (match_dup 4)) (clobber (reg:CC CC_REG))])]) @@ -241,7 +241,7 @@ && !h8300_shift_needs_scratch_p (INTVAL (operands[2]), HImode, GET_CODE (operands[3])))" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (reg:CC CC_REG))])]) @@ -268,7 +268,7 @@ (clobber (match_scratch:QI 4 "=X,&r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (match_dup 4)) (clobber (reg:CC CC_REG))])]) @@ -296,7 +296,7 @@ && !h8300_shift_needs_scratch_p (INTVAL (operands[2]), SImode, GET_CODE (operands[3])))" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 3 [(match_dup 1) (match_dup 2)])) (clobber (reg:CC CC_REG))])]) @@ -410,7 +410,7 @@ (match_operand:QI 2 "immediate_operand" "")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (rotate:QHSI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) -- cgit v1.1 From d514626ee2566c68b8a79c7b99aaf791d69e1b2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= Date: Sat, 5 Jun 2021 11:12:50 +0000 Subject: Fortran: Fix some issues with pointers to character. gcc/fortran/ChangeLog: PR fortran/100120 PR fortran/100816 PR fortran/100818 PR fortran/100819 PR fortran/100821 * trans-array.c (gfc_get_array_span): rework the way character array "span" was calculated. (gfc_conv_expr_descriptor): improve handling of character sections and unlimited polymorphic objects. * trans-expr.c (gfc_get_character_len): new function to calculate character string length. (gfc_get_character_len_in_bytes): new function to calculate character string length in bytes. (gfc_conv_scalar_to_descriptor): add call to set the "span". (gfc_trans_pointer_assignment): set "_len" and antecipate the initialization of the deferred character length hidden argument. * trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to avoid the creation of a temporary. * trans-types.c (gfc_get_dtype_rank_type): rework type detection so that unlimited polymorphic objects get proper type infomation, also important for bind(c). (gfc_get_dtype): add argument to pass the rank if necessary. (gfc_get_array_type_bounds): cosmetic change to have character arrays called character instead of unknown. * trans-types.h (gfc_get_dtype): modify prototype. * trans.c (get_array_span): rework the way character array "span" was calculated. * trans.h (gfc_get_character_len): new prototype. (gfc_get_character_len_in_bytes): new prototype. Add "unlimited_polymorphic" flag to "gfc_se" type to signal when expression carries an unlimited polymorphic object. libgfortran/ChangeLog: PR fortran/100120 * intrinsics/associated.c (associated): have associated verify if the "span" matches insted of the "elem_len". * libgfortran.h (GFC_DESCRIPTOR_SPAN): add macro to retrive the descriptor "span". gcc/testsuite/ChangeLog: PR fortran/100120 * gfortran.dg/PR100120.f90: New test. PR fortran/100816 PR fortran/100818 PR fortran/100819 PR fortran/100821 * gfortran.dg/character_workout_1.f90: New test. * gfortran.dg/character_workout_4.f90: New test. --- gcc/fortran/trans-array.c | 61 +- gcc/fortran/trans-expr.c | 70 ++- gcc/fortran/trans-intrinsic.c | 1 + gcc/fortran/trans-types.c | 68 ++- gcc/fortran/trans-types.h | 2 +- gcc/fortran/trans.c | 26 +- gcc/fortran/trans.h | 5 + gcc/testsuite/gfortran.dg/PR100120.f90 | 198 +++++++ gcc/testsuite/gfortran.dg/character_workout_1.f90 | 689 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/character_workout_4.f90 | 689 ++++++++++++++++++++++ 10 files changed, 1730 insertions(+), 79 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100120.f90 create mode 100644 gcc/testsuite/gfortran.dg/character_workout_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/character_workout_4.f90 (limited to 'gcc') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 7eeef55..a6bcd2b 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -860,16 +860,25 @@ gfc_get_array_span (tree desc, gfc_expr *expr) size of the array. Attempt to deal with unbounded character types if possible. Otherwise, return NULL_TREE. */ tmp = gfc_get_element_type (TREE_TYPE (desc)); - if (tmp && TREE_CODE (tmp) == ARRAY_TYPE - && (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)) == NULL_TREE - || integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp))))) - { - if (expr->expr_type == EXPR_VARIABLE - && expr->ts.type == BT_CHARACTER) - tmp = fold_convert (gfc_array_index_type, - gfc_get_expr_charlen (expr)); - else - tmp = NULL_TREE; + if (tmp && TREE_CODE (tmp) == ARRAY_TYPE && TYPE_STRING_FLAG (tmp)) + { + gcc_assert (expr->ts.type == BT_CHARACTER); + + tmp = gfc_get_character_len_in_bytes (tmp); + + if (tmp == NULL_TREE || integer_zerop (tmp)) + { + tree bs; + + tmp = gfc_get_expr_charlen (expr); + tmp = fold_convert (gfc_array_index_type, tmp); + bs = build_int_cst (gfc_array_index_type, expr->ts.kind); + tmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, tmp, bs); + } + + tmp = (tmp && !integer_zerop (tmp)) + ? (fold_convert (gfc_array_index_type, tmp)) : (NULL_TREE); } else tmp = fold_convert (gfc_array_index_type, @@ -7328,6 +7337,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) expr = expr->value.function.actual->expr; } + if (!se->direct_byref) + se->unlimited_polymorphic = UNLIMITED_POLY (expr); + /* Special case things we know we can pass easily. */ switch (expr->expr_type) { @@ -7351,9 +7363,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) && TREE_CODE (desc) == COMPONENT_REF) deferred_array_component = true; - subref_array_target = se->direct_byref && is_subref_array (expr); - need_tmp = gfc_ref_needs_temporary_p (expr->ref) - && !subref_array_target; + subref_array_target = (is_subref_array (expr) + && (se->direct_byref + || expr->ts.type == BT_CHARACTER)); + need_tmp = (gfc_ref_needs_temporary_p (expr->ref) + && !subref_array_target); if (se->force_tmp) need_tmp = 1; @@ -7390,9 +7404,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) subref_array_target, expr); /* ....and set the span field. */ - tmp = gfc_get_array_span (desc, expr); - if (tmp != NULL_TREE && !integer_zerop (tmp)) - gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); + tmp = gfc_conv_descriptor_span_get (desc); + gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); } else if (se->want_pointer) { @@ -7607,6 +7620,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) int dim, ndim, codim; tree parm; tree parmtype; + tree dtype; tree stride; tree from; tree to; @@ -7689,7 +7703,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) else { /* Otherwise make a new one. */ - if (expr->ts.type == BT_CHARACTER && expr->ts.deferred) + if (expr->ts.type == BT_CHARACTER) parmtype = gfc_typenode_for_spec (&expr->ts); else parmtype = gfc_get_element_type (TREE_TYPE (desc)); @@ -7723,11 +7737,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) } /* Set the span field. */ - if (expr->ts.type == BT_CHARACTER && ss_info->string_length) - tmp = ss_info->string_length; - else - tmp = gfc_get_array_span (desc, expr); - if (tmp != NULL_TREE) + tmp = gfc_get_array_span (desc, expr); + if (tmp) gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); /* The following can be somewhat confusing. We have two @@ -7741,7 +7752,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* Set the dtype. */ tmp = gfc_conv_descriptor_dtype (parm); - gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype)); + if (se->unlimited_polymorphic) + dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen); + else + dtype = gfc_get_dtype (parmtype); + gfc_add_modify (&loop.pre, tmp, dtype); /* The 1st element in the section. */ base = gfc_index_zero_node; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 00690fe..e3bc886 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -42,6 +42,45 @@ along with GCC; see the file COPYING3. If not see #include "dependency.h" #include "gimplify.h" + +/* Calculate the number of characters in a string. */ + +tree +gfc_get_character_len (tree type) +{ + tree len; + + gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE + && TYPE_STRING_FLAG (type)); + + len = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); + len = (len) ? (len) : (integer_zero_node); + return fold_convert (gfc_charlen_type_node, len); +} + + + +/* Calculate the number of bytes in a string. */ + +tree +gfc_get_character_len_in_bytes (tree type) +{ + tree tmp, len; + + gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE + && TYPE_STRING_FLAG (type)); + + tmp = TYPE_SIZE_UNIT (TREE_TYPE (type)); + tmp = (tmp && !integer_zerop (tmp)) + ? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE); + len = gfc_get_character_len (type); + if (tmp && len && !integer_zerop (len)) + len = fold_build2_loc (input_location, MULT_EXPR, + gfc_charlen_type_node, len, tmp); + return len; +} + + /* Convert a scalar to an array descriptor. To be used for assumed-rank arrays. */ @@ -87,6 +126,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc), gfc_get_dtype_rank_type (0, etype)); gfc_conv_descriptor_data_set (&se->pre, desc, scalar); + gfc_conv_descriptor_span_set (&se->pre, desc, + gfc_conv_descriptor_elem_len (desc)); /* Copy pointer address back - but only if it could have changed and if the actual argument is a pointer and not, e.g., NULL(). */ @@ -9630,11 +9671,12 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) lse.direct_byref = 1; gfc_conv_expr_descriptor (&lse, expr2); strlen_rhs = lse.string_length; + gfc_init_se (&rse, NULL); if (expr1->ts.type == BT_CLASS) { rse.expr = NULL_TREE; - rse.string_length = NULL_TREE; + rse.string_length = strlen_rhs; trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL, NULL); } @@ -9694,6 +9736,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_add_modify (&lse.pre, desc, tmp); } + if (expr1->ts.type == BT_CHARACTER + && expr1->symtree->n.sym->ts.deferred + && expr1->symtree->n.sym->ts.u.cl->backend_decl + && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl)) + { + tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl; + if (expr2->expr_type != EXPR_NULL) + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), strlen_rhs)); + else + gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp))); + } + gfc_add_block_to_block (&block, &lse.pre); if (rank_remap) gfc_add_block_to_block (&block, &rse.pre); @@ -9856,19 +9911,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) msg, rsize, lsize); } - if (expr1->ts.type == BT_CHARACTER - && expr1->symtree->n.sym->ts.deferred - && expr1->symtree->n.sym->ts.u.cl->backend_decl - && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl)) - { - tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl; - if (expr2->expr_type != EXPR_NULL) - gfc_add_modify (&block, tmp, - fold_convert (TREE_TYPE (tmp), strlen_rhs)); - else - gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp))); - } - /* Check string lengths if applicable. The check is only really added to the output code if -fbounds-check is enabled. */ if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 98fa28d..73b0bcc 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -9080,6 +9080,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&se->post, &arg1se.post); arg2se.want_pointer = 1; + arg2se.force_no_tmp = 1; gfc_conv_expr_descriptor (&arg2se, arg2->expr); gfc_add_block_to_block (&se->pre, &arg2se.pre); gfc_add_block_to_block (&se->post, &arg2se.post); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 9f21b3e..5582e40 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1482,6 +1482,7 @@ gfc_get_desc_dim_type (void) tree gfc_get_dtype_rank_type (int rank, tree etype) { + tree ptype; tree size; int n; tree tmp; @@ -1489,12 +1490,24 @@ gfc_get_dtype_rank_type (int rank, tree etype) tree field; vec *v = NULL; - size = TYPE_SIZE_UNIT (etype); + ptype = etype; + while (TREE_CODE (etype) == POINTER_TYPE + || TREE_CODE (etype) == ARRAY_TYPE) + { + ptype = etype; + etype = TREE_TYPE (etype); + } + + gcc_assert (etype); switch (TREE_CODE (etype)) { case INTEGER_TYPE: - n = BT_INTEGER; + if (TREE_CODE (ptype) == ARRAY_TYPE + && TYPE_STRING_FLAG (ptype)) + n = BT_CHARACTER; + else + n = BT_INTEGER; break; case BOOLEAN_TYPE: @@ -1516,27 +1529,36 @@ gfc_get_dtype_rank_type (int rank, tree etype) n = BT_DERIVED; break; - /* We will never have arrays of arrays. */ - case ARRAY_TYPE: - n = BT_CHARACTER; - if (size == NULL_TREE) - size = TYPE_SIZE_UNIT (TREE_TYPE (etype)); + case FUNCTION_TYPE: + case VOID_TYPE: + n = BT_VOID; break; - case POINTER_TYPE: - n = BT_ASSUMED; - if (TREE_CODE (TREE_TYPE (etype)) != VOID_TYPE) - size = TYPE_SIZE_UNIT (TREE_TYPE (etype)); - else - size = build_int_cst (size_type_node, 0); - break; - default: /* TODO: Don't do dtype for temporary descriptorless arrays. */ /* We can encounter strange array types for temporary arrays. */ - return gfc_index_zero_node; + gcc_unreachable (); } + switch (n) + { + case BT_CHARACTER: + gcc_assert (TREE_CODE (ptype) == ARRAY_TYPE); + size = gfc_get_character_len_in_bytes (ptype); + break; + case BT_VOID: + gcc_assert (TREE_CODE (ptype) == POINTER_TYPE); + size = size_in_bytes (ptype); + break; + default: + size = size_in_bytes (etype); + break; + } + + gcc_assert (size); + + STRIP_NOPS (size); + size = fold_convert (size_type_node, size); tmp = get_dtype_type_node (); field = gfc_advance_chain (TYPE_FIELDS (tmp), GFC_DTYPE_ELEM_LEN); @@ -1560,17 +1582,17 @@ gfc_get_dtype_rank_type (int rank, tree etype) tree -gfc_get_dtype (tree type) +gfc_get_dtype (tree type, int * rank) { tree dtype; tree etype; - int rank; + int irnk; gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)); - rank = GFC_TYPE_ARRAY_RANK (type); + irnk = (rank) ? (*rank) : (GFC_TYPE_ARRAY_RANK (type)); etype = gfc_get_element_type (type); - dtype = gfc_get_dtype_rank_type (rank, etype); + dtype = gfc_get_dtype_rank_type (irnk, etype); GFC_TYPE_ARRAY_DTYPE (type) = dtype; return dtype; @@ -1912,7 +1934,11 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, TYPE_TYPELESS_STORAGE (fat_type) = 1; gcc_checking_assert (!get_alias_set (base_type) && !get_alias_set (fat_type)); - tmp = TYPE_NAME (etype); + tmp = etype; + if (TREE_CODE (tmp) == ARRAY_TYPE + && TYPE_STRING_FLAG (tmp)) + tmp = TREE_TYPE (etype); + tmp = TYPE_NAME (tmp); if (tmp && TREE_CODE (tmp) == TYPE_DECL) tmp = DECL_NAME (tmp); if (tmp) diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index ff01226..3b45ce2 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -114,7 +114,7 @@ int gfc_is_nodesc_array (gfc_symbol *); /* Return the DTYPE for an array. */ tree gfc_get_dtype_rank_type (int, tree); -tree gfc_get_dtype (tree); +tree gfc_get_dtype (tree, int *rank = NULL); tree gfc_get_ppc_type (gfc_component *); tree gfc_get_caf_vector_type (int dim); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 3ffa394..f26e91b 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -371,30 +371,16 @@ get_array_span (tree type, tree decl) return gfc_conv_descriptor_span_get (decl); /* Return the span for deferred character length array references. */ - if (type && TREE_CODE (type) == ARRAY_TYPE - && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE - && (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) - || TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF) - && (TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF - || TREE_CODE (decl) == FUNCTION_DECL - || DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) - == DECL_CONTEXT (decl))) - { - span = fold_convert (gfc_array_index_type, - TYPE_MAX_VALUE (TYPE_DOMAIN (type))); - span = fold_build2 (MULT_EXPR, gfc_array_index_type, - fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (TREE_TYPE (type))), - span); - } - else if (type && TREE_CODE (type) == ARRAY_TYPE - && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE - && integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))) + if (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_STRING_FLAG (type)) { + if (TREE_CODE (decl) == PARM_DECL) + decl = build_fold_indirect_ref_loc (input_location, decl); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) span = gfc_conv_descriptor_span_get (decl); else - span = NULL_TREE; + span = gfc_get_character_len_in_bytes (type); + span = (span && !integer_zerop (span)) + ? (fold_convert (gfc_array_index_type, span)) : (NULL_TREE); } /* Likewise for class array or pointer array references. */ else if (TREE_CODE (decl) == FIELD_DECL diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 69d3fdc..d1d4a1d 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -53,6 +53,9 @@ typedef struct gfc_se here. */ tree class_vptr; + /* Whether expr is a reference to an unlimited polymorphic object. */ + unsigned unlimited_polymorphic:1; + /* If set gfc_conv_variable will return an expression for the array descriptor. When set, want_pointer should also be set. If not set scalarizing variables will be substituted. */ @@ -506,6 +509,8 @@ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); /* trans-expr.c */ +tree gfc_get_character_len (tree); +tree gfc_get_character_len_in_bytes (tree); tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute); tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *); void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr); diff --git a/gcc/testsuite/gfortran.dg/PR100120.f90 b/gcc/testsuite/gfortran.dg/PR100120.f90 new file mode 100644 index 0000000..c1e6c99 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100120.f90 @@ -0,0 +1,198 @@ +! { dg-do run } +! +! Tests fix for PR100120 +! + +program main_p + + implicit none + + integer, parameter :: n = 11 + integer, parameter :: m = 7 + integer, parameter :: c = 63 + + type :: foo_t + integer :: i + end type foo_t + + type, extends(foo_t) :: bar_t + integer :: j(n) + end type bar_t + + integer, target :: ain(n) + character, target :: ac1(n) + character(len=m), target :: acn(n) + type(foo_t), target :: afd(n) + type(bar_t), target :: abd(n) + ! + class(foo_t), pointer :: spf + class(foo_t), pointer :: apf(:) + class(bar_t), pointer :: spb + class(bar_t), pointer :: apb(:) + class(*), pointer :: spu + class(*), pointer :: apu(:) + integer :: i, j + + ain = [(i, i=1,n)] + ac1 = [(achar(i+c), i=1,n)] + do i = 1, n + do j = 1, m + acn(i)(j:j) = achar(i*m+j+c-m) + end do + end do + afd%i = ain + abd%i = ain + do i = 1, n + abd(i)%j = 2*i*ain + end do + ! + spf => afd(n) + if(.not.associated(spf)) stop 1 + if(.not.associated(spf, afd(n))) stop 2 + if(spf%i/=n) stop 3 + apf => afd + if(.not.associated(apf)) stop 4 + if(.not.associated(apf, afd)) stop 5 + if(any(apf%i/=afd%i)) stop 6 + ! + spf => abd(n) + if(.not.associated(spf)) stop 7 + if(.not.associated(spf, abd(n))) stop 8 + if(spf%i/=n) stop 9 + select type(spf) + type is(bar_t) + if(any(spf%j/=2*n*ain)) stop 10 + class default + stop 11 + end select + apf => abd + if(.not.associated(apf)) stop 12 + if(.not.associated(apf, abd)) stop 13 + if(any(apf%i/=abd%i)) stop 14 + select type(apf) + type is(bar_t) + do i = 1, n + if(any(apf(i)%j/=2*i*ain)) stop 15 + end do + class default + stop 16 + end select + ! + spb => abd(n) + if(.not.associated(spb)) stop 17 + if(.not.associated(spb, abd(n))) stop 18 + if(spb%i/=n) stop 19 + if(any(spb%j/=2*n*ain)) stop 20 + apb => abd + if(.not.associated(apb)) stop 21 + if(.not.associated(apb, abd)) stop 22 + if(any(apb%i/=abd%i)) stop 23 + do i = 1, n + if(any(apb(i)%j/=2*i*ain)) stop 24 + end do + ! + spu => ain(n) + if(.not.associated(spu)) stop 25 + if(.not.associated(spu, ain(n))) stop 26 + select type(spu) + type is(integer) + if(spu/=n) stop 27 + class default + stop 28 + end select + apu => ain + if(.not.associated(apu)) stop 29 + if(.not.associated(apu, ain)) stop 30 + select type(apu) + type is(integer) + if(any(apu/=ain)) stop 31 + class default + stop 32 + end select + ! + spu => ac1(n) + if(.not.associated(spu)) stop 33 + if(.not.associated(spu, ac1(n))) stop 34 + select type(spu) + type is(character(len=*)) + if(len(spu)/=1) stop 35 + if(spu/=ac1(n)) stop 36 + class default + stop 37 + end select + apu => ac1 + if(.not.associated(apu)) stop 38 + if(.not.associated(apu, ac1)) stop 39 + select type(apu) + type is(character(len=*)) + if(len(apu)/=1) stop 40 + if(any(apu/=ac1)) stop 41 + class default + stop 42 + end select + ! + spu => acn(n) + if(.not.associated(spu)) stop 43 + if(.not.associated(spu, acn(n))) stop 44 + select type(spu) + type is(character(len=*)) + if(len(spu)/=m) stop 45 + if(spu/=acn(n)) stop 46 + class default + stop 47 + end select + apu => acn + if(.not.associated(apu)) stop 48 + if(.not.associated(apu, acn)) stop 49 + select type(apu) + type is(character(len=*)) + if(len(apu)/=m) stop 50 + if(any(apu/=acn)) stop 51 + class default + stop 52 + end select + ! + spu => afd(n) + if(.not.associated(spu)) stop 53 + if(.not.associated(spu, afd(n))) stop 54 + select type(spu) + type is(foo_t) + if(spu%i/=n) stop 55 + class default + stop 56 + end select + apu => afd + if(.not.associated(apu)) stop 57 + if(.not.associated(apu, afd)) stop 58 + select type(apu) + type is(foo_t) + if(any(apu%i/=afd%i)) stop 59 + class default + stop 60 + end select + ! + spu => abd(n) + if(.not.associated(spu)) stop 61 + if(.not.associated(spu, abd(n))) stop 62 + select type(spu) + type is(bar_t) + if(spu%i/=n) stop 63 + if(any(spu%j/=2*n*ain)) stop 64 + class default + stop 65 + end select + apu => abd + if(.not.associated(apu)) stop 66 + if(.not.associated(apu, abd)) stop 67 + select type(apu) + type is(bar_t) + if(any(apu%i/=abd%i)) stop 68 + do i = 1, n + if(any(apu(i)%j/=2*i*ain)) stop 69 + end do + class default + stop 70 + end select + stop + +end program main_p diff --git a/gcc/testsuite/gfortran.dg/character_workout_1.f90 b/gcc/testsuite/gfortran.dg/character_workout_1.f90 new file mode 100644 index 0000000..98133b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_workout_1.f90 @@ -0,0 +1,689 @@ +! { dg-do run } +! +! Tests fix for PR100120/100816/100818/100819/100821 +! + +program main_p + + implicit none + + integer, parameter :: k = 1 + integer, parameter :: n = 11 + integer, parameter :: m = 7 + integer, parameter :: l = 3 + integer, parameter :: u = 5 + integer, parameter :: e = u-l+1 + integer, parameter :: c = 61 + + character(kind=k), target :: c1(n) + character(len=m, kind=k), target :: cm(n) + ! + character(kind=k), pointer :: s1 + character(len=m, kind=k), pointer :: sm + character(len=e, kind=k), pointer :: se + character(len=:, kind=k), pointer :: sd + ! + character(kind=k), pointer :: p1(:) + character(len=m, kind=k), pointer :: pm(:) + character(len=e, kind=k), pointer :: pe(:) + character(len=:, kind=k), pointer :: pd(:) + + class(*), pointer :: su + class(*), pointer :: pu(:) + + integer :: i, j + + nullify(s1, sm, se, sd, su) + nullify(p1, pm, pe, pd, pu) + c1 = [(char(i+c, kind=k), i=1,n)] + do i = 1, n + do j = 1, m + cm(i)(j:j) = char(i*m+j+c-m, kind=k) + end do + end do + + s1 => c1(n) + if(.not.associated(s1)) stop 1 + if(.not.associated(s1, c1(n))) stop 2 + if(len(s1)/=1) stop 3 + if(s1/=c1(n)) stop 4 + call schar_c1(s1) + call schar_a1(s1) + p1 => c1 + if(.not.associated(p1)) stop 5 + if(.not.associated(p1, c1)) stop 6 + if(len(p1)/=1) stop 7 + if(any(p1/=c1)) stop 8 + call achar_c1(p1) + call achar_a1(p1) + ! + sm => cm(n) + if(.not.associated(sm)) stop 9 + if(.not.associated(sm, cm(n))) stop 10 + if(len(sm)/=m) stop 11 + if(sm/=cm(n)) stop 12 + call schar_cm(sm) + call schar_am(sm) + pm => cm + if(.not.associated(pm)) stop 13 + if(.not.associated(pm, cm)) stop 14 + if(len(pm)/=m) stop 15 + if(any(pm/=cm)) stop 16 + call achar_cm(pm) + call achar_am(pm) + ! + se => cm(n)(l:u) + if(.not.associated(se)) stop 17 + if(.not.associated(se, cm(n)(l:u))) stop 18 + if(len(se)/=e) stop 19 + if(se/=cm(n)(l:u)) stop 20 + call schar_ce(se) + call schar_ae(se) + pe => cm(:)(l:u) + if(.not.associated(pe)) stop 21 + if(.not.associated(pe, cm(:)(l:u))) stop 22 + if(len(pe)/=e) stop 23 + if(any(pe/=cm(:)(l:u))) stop 24 + call achar_ce(pe) + call achar_ae(pe) + ! + sd => c1(n) + if(.not.associated(sd)) stop 25 + if(.not.associated(sd, c1(n))) stop 26 + if(len(sd)/=1) stop 27 + if(sd/=c1(n)) stop 28 + call schar_d1(sd) + pd => c1 + if(.not.associated(pd)) stop 29 + if(.not.associated(pd, c1)) stop 30 + if(len(pd)/=1) stop 31 + if(any(pd/=c1)) stop 32 + call achar_d1(pd) + ! + sd => cm(n) + if(.not.associated(sd)) stop 33 + if(.not.associated(sd, cm(n))) stop 34 + if(len(sd)/=m) stop 35 + if(sd/=cm(n)) stop 36 + call schar_dm(sd) + pd => cm + if(.not.associated(pd)) stop 37 + if(.not.associated(pd, cm)) stop 38 + if(len(pd)/=m) stop 39 + if(any(pd/=cm)) stop 40 + call achar_dm(pd) + ! + sd => cm(n)(l:u) + if(.not.associated(sd)) stop 41 + if(.not.associated(sd, cm(n)(l:u))) stop 42 + if(len(sd)/=e) stop 43 + if(sd/=cm(n)(l:u)) stop 44 + call schar_de(sd) + pd => cm(:)(l:u) + if(.not.associated(pd)) stop 45 + if(.not.associated(pd, cm(:)(l:u))) stop 46 + if(len(pd)/=e) stop 47 + if(any(pd/=cm(:)(l:u))) stop 48 + call achar_de(pd) + ! + sd => c1(n) + s1 => sd + if(.not.associated(s1)) stop 49 + if(.not.associated(s1, c1(n))) stop 50 + if(len(s1)/=1) stop 51 + if(s1/=c1(n)) stop 52 + call schar_c1(s1) + call schar_a1(s1) + pd => c1 + s1 => pd(n) + if(.not.associated(s1)) stop 53 + if(.not.associated(s1, c1(n))) stop 54 + if(len(s1)/=1) stop 55 + if(s1/=c1(n)) stop 56 + call schar_c1(s1) + call schar_a1(s1) + pd => c1 + p1 => pd + if(.not.associated(p1)) stop 57 + if(.not.associated(p1, c1)) stop 58 + if(len(p1)/=1) stop 59 + if(any(p1/=c1)) stop 60 + call achar_c1(p1) + call achar_a1(p1) + ! + sd => cm(n) + sm => sd + if(.not.associated(sm)) stop 61 + if(.not.associated(sm, cm(n))) stop 62 + if(len(sm)/=m) stop 63 + if(sm/=cm(n)) stop 64 + call schar_cm(sm) + call schar_am(sm) + pd => cm + sm => pd(n) + if(.not.associated(sm)) stop 65 + if(.not.associated(sm, cm(n))) stop 66 + if(len(sm)/=m) stop 67 + if(sm/=cm(n)) stop 68 + call schar_cm(sm) + call schar_am(sm) + pd => cm + pm => pd + if(.not.associated(pm)) stop 69 + if(.not.associated(pm, cm)) stop 70 + if(len(pm)/=m) stop 71 + if(any(pm/=cm)) stop 72 + call achar_cm(pm) + call achar_am(pm) + ! + sd => cm(n)(l:u) + se => sd + if(.not.associated(se)) stop 73 + if(.not.associated(se, cm(n)(l:u))) stop 74 + if(len(se)/=e) stop 75 + if(se/=cm(n)(l:u)) stop 76 + call schar_ce(se) + call schar_ae(se) + pd => cm(:)(l:u) + pe => pd + if(.not.associated(pe)) stop 77 + if(.not.associated(pe, cm(:)(l:u))) stop 78 + if(len(pe)/=e) stop 79 + if(any(pe/=cm(:)(l:u))) stop 80 + call achar_ce(pe) + call achar_ae(pe) + ! + su => c1(n) + if(.not.associated(su)) stop 81 + if(.not.associated(su, c1(n))) stop 82 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=1) stop 83 + if(su/=c1(n)) stop 84 + class default + stop 85 + end select + call schar_u1(su) + pu => c1 + if(.not.associated(pu)) stop 86 + if(.not.associated(pu, c1)) stop 87 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=1) stop 88 + if(any(pu/=c1)) stop 89 + class default + stop 90 + end select + call achar_u1(pu) + ! + su => cm(n) + if(.not.associated(su)) stop 91 + if(.not.associated(su)) stop 92 + if(.not.associated(su, cm(n))) stop 93 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=m) stop 94 + if(su/=cm(n)) stop 95 + class default + stop 96 + end select + call schar_um(su) + pu => cm + if(.not.associated(pu)) stop 97 + if(.not.associated(pu, cm)) stop 98 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=m) stop 99 + if(any(pu/=cm)) stop 100 + class default + stop 101 + end select + call achar_um(pu) + ! + su => cm(n)(l:u) + if(.not.associated(su)) stop 102 + if(.not.associated(su, cm(n)(l:u))) stop 103 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 104 + if(su/=cm(n)(l:u)) stop 105 + class default + stop 106 + end select + call schar_ue(su) + pu => cm(:)(l:u) + if(.not.associated(pu)) stop 107 + if(.not.associated(pu, cm(:)(l:u))) stop 108 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=e) stop 109 + if(any(pu/=cm(:)(l:u))) stop 110 + class default + stop 111 + end select + call achar_ue(pu) + ! + sd => c1(n) + su => sd + if(.not.associated(su)) stop 112 + if(.not.associated(su, c1(n))) stop 113 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=1) stop 114 + if(su/=c1(n)) stop 115 + class default + stop 116 + end select + call schar_u1(su) + pd => c1 + su => pd(n) + if(.not.associated(su)) stop 117 + if(.not.associated(su, c1(n))) stop 118 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=1) stop 119 + if(su/=c1(n)) stop 120 + class default + stop 121 + end select + call schar_u1(su) + pd => c1 + pu => pd + if(.not.associated(pu)) stop 122 + if(.not.associated(pu, c1)) stop 123 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=1) stop 124 + if(any(pu/=c1)) stop 125 + class default + stop 126 + end select + call achar_u1(pu) + ! + sd => cm(n) + su => sd + if(.not.associated(su)) stop 127 + if(.not.associated(su, cm(n))) stop 128 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=m) stop 129 + if(su/=cm(n)) stop 130 + class default + stop 131 + end select + call schar_um(su) + pd => cm + su => pd(n) + if(.not.associated(su)) stop 132 + if(.not.associated(su, cm(n))) stop 133 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=m) stop 134 + if(su/=cm(n)) stop 135 + class default + stop 136 + end select + call schar_um(su) + pd => cm + pu => pd + if(.not.associated(pu)) stop 137 + if(.not.associated(pu, cm)) stop 138 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=m) stop 139 + if(any(pu/=cm)) stop 140 + class default + stop 141 + end select + call achar_um(pu) + ! + sd => cm(n)(l:u) + su => sd + if(.not.associated(su)) stop 142 + if(.not.associated(su, cm(n)(l:u))) stop 143 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 144 + if(su/=cm(n)(l:u)) stop 145 + class default + stop 146 + end select + call schar_ue(su) + pd => cm(:)(l:u) + su => pd(n) + if(.not.associated(su)) stop 147 + if(.not.associated(su, cm(n)(l:u))) stop 148 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 149 + if(su/=cm(n)(l:u)) stop 150 + class default + stop 151 + end select + call schar_ue(su) + pd => cm(:)(l:u) + pu => pd + if(.not.associated(pu)) stop 152 + if(.not.associated(pu, cm(:)(l:u))) stop 153 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=e) stop 154 + if(any(pu/=cm(:)(l:u))) stop 155 + class default + stop 156 + end select + call achar_ue(pu) + ! + sd => cm(n) + su => sd(l:u) + if(.not.associated(su)) stop 157 + if(.not.associated(su, cm(n)(l:u))) stop 158 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 159 + if(su/=cm(n)(l:u)) stop 160 + class default + stop 161 + end select + call schar_ue(su) + pd => cm(:) + su => pd(n)(l:u) + if(.not.associated(su)) stop 162 + if(.not.associated(su, cm(n)(l:u))) stop 163 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 164 + if(su/=cm(n)(l:u)) stop 165 + class default + stop 166 + end select + call schar_ue(su) + pd => cm + pu => pd(:)(l:u) + if(.not.associated(pu)) stop 167 + if(.not.associated(pu, cm(:)(l:u))) stop 168 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=e) stop 169 + if(any(pu/=cm(:)(l:u))) stop 170 + class default + stop 171 + end select + call achar_ue(pu) + ! + stop + +contains + + subroutine schar_c1(a) + character(kind=k), pointer, intent(in) :: a + + if(.not.associated(a)) stop 172 + if(.not.associated(a, c1(n))) stop 173 + if(len(a)/=1) stop 174 + if(a/=c1(n)) stop 175 + return + end subroutine schar_c1 + + subroutine achar_c1(a) + character(kind=k), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 176 + if(.not.associated(a, c1)) stop 177 + if(len(a)/=1) stop 178 + if(any(a/=c1)) stop 179 + return + end subroutine achar_c1 + + subroutine schar_cm(a) + character(kind=k, len=m), pointer, intent(in) :: a + + if(.not.associated(a)) stop 180 + if(.not.associated(a, cm(n))) stop 181 + if(len(a)/=m) stop 182 + if(a/=cm(n)) stop 183 + return + end subroutine schar_cm + + subroutine achar_cm(a) + character(kind=k, len=m), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 184 + if(.not.associated(a, cm)) stop 185 + if(len(a)/=m) stop 186 + if(any(a/=cm)) stop 187 + return + end subroutine achar_cm + + subroutine schar_ce(a) + character(kind=k, len=e), pointer, intent(in) :: a + + if(.not.associated(a)) stop 188 + if(.not.associated(a, cm(n)(l:u))) stop 189 + if(len(a)/=e) stop 190 + if(a/=cm(n)(l:u)) stop 191 + return + end subroutine schar_ce + + subroutine achar_ce(a) + character(kind=k, len=e), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 192 + if(.not.associated(a, cm(:)(l:u))) stop 193 + if(len(a)/=e) stop 194 + if(any(a/=cm(:)(l:u))) stop 195 + return + end subroutine achar_ce + + subroutine schar_a1(a) + character(kind=k, len=*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 196 + if(.not.associated(a, c1(n))) stop 197 + if(len(a)/=1) stop 198 + if(a/=c1(n)) stop 199 + return + end subroutine schar_a1 + + subroutine achar_a1(a) + character(kind=k, len=*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 200 + if(.not.associated(a, c1)) stop 201 + if(len(a)/=1) stop 202 + if(any(a/=c1)) stop 203 + return + end subroutine achar_a1 + + subroutine schar_am(a) + character(kind=k, len=*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 204 + if(.not.associated(a, cm(n))) stop 205 + if(len(a)/=m) stop 206 + if(a/=cm(n)) stop 207 + return + end subroutine schar_am + + subroutine achar_am(a) + character(kind=k, len=*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 208 + if(.not.associated(a, cm)) stop 209 + if(len(a)/=m) stop 210 + if(any(a/=cm)) stop 211 + return + end subroutine achar_am + + subroutine schar_ae(a) + character(kind=k, len=*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 212 + if(.not.associated(a, cm(n)(l:u))) stop 213 + if(len(a)/=e) stop 214 + if(a/=cm(n)(l:u)) stop 215 + return + end subroutine schar_ae + + subroutine achar_ae(a) + character(kind=k, len=*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 216 + if(.not.associated(a, cm(:)(l:u))) stop 217 + if(len(a)/=e) stop 218 + if(any(a/=cm(:)(l:u))) stop 219 + return + end subroutine achar_ae + + subroutine schar_d1(a) + character(kind=k, len=:), pointer, intent(in) :: a + + if(.not.associated(a)) stop 220 + if(.not.associated(a, c1(n))) stop 221 + if(len(a)/=1) stop 222 + if(a/=c1(n)) stop 223 + return + end subroutine schar_d1 + + subroutine achar_d1(a) + character(kind=k, len=:), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 224 + if(.not.associated(a, c1)) stop 225 + if(len(a)/=1) stop 226 + if(any(a/=c1)) stop 227 + return + end subroutine achar_d1 + + subroutine schar_dm(a) + character(kind=k, len=:), pointer, intent(in) :: a + + if(.not.associated(a)) stop 228 + if(.not.associated(a, cm(n))) stop 229 + if(len(a)/=m) stop 230 + if(a/=cm(n)) stop 231 + return + end subroutine schar_dm + + subroutine achar_dm(a) + character(kind=k, len=:), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 232 + if(.not.associated(a, cm)) stop 233 + if(len(a)/=m) stop 234 + if(any(a/=cm)) stop 235 + return + end subroutine achar_dm + + subroutine schar_de(a) + character(kind=k, len=:), pointer, intent(in) :: a + + if(.not.associated(a)) stop 236 + if(.not.associated(a, cm(n)(l:u))) stop 237 + if(len(a)/=e) stop 238 + if(a/=cm(n)(l:u)) stop 239 + return + end subroutine schar_de + + subroutine achar_de(a) + character(kind=k, len=:), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 240 + if(.not.associated(a, cm(:)(l:u))) stop 241 + if(len(a)/=e) stop 242 + if(any(a/=cm(:)(l:u))) stop 243 + return + end subroutine achar_de + + subroutine schar_u1(a) + class(*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 244 + if(.not.associated(a, c1(n))) stop 245 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=1) stop 246 + if(a/=c1(n)) stop 247 + class default + stop 248 + end select + return + end subroutine schar_u1 + + subroutine achar_u1(a) + class(*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 249 + if(.not.associated(a, c1)) stop 250 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=1) stop 251 + if(any(a/=c1)) stop 252 + class default + stop 253 + end select + return + end subroutine achar_u1 + + subroutine schar_um(a) + class(*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 254 + if(.not.associated(a)) stop 255 + if(.not.associated(a, cm(n))) stop 256 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=m) stop 257 + if(a/=cm(n)) stop 258 + class default + stop 259 + end select + return + end subroutine schar_um + + subroutine achar_um(a) + class(*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 260 + if(.not.associated(a, cm)) stop 261 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=m) stop 262 + if(any(a/=cm)) stop 263 + class default + stop 264 + end select + return + end subroutine achar_um + + subroutine schar_ue(a) + class(*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 265 + if(.not.associated(a, cm(n)(l:u))) stop 266 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=e) stop 267 + if(a/=cm(n)(l:u)) stop 268 + class default + stop 269 + end select + return + end subroutine schar_ue + + subroutine achar_ue(a) + class(*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 270 + if(.not.associated(a, cm(:)(l:u))) stop 271 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=e) stop 272 + if(any(a/=cm(:)(l:u))) stop 273 + class default + stop 274 + end select + return + end subroutine achar_ue + +end program main_p diff --git a/gcc/testsuite/gfortran.dg/character_workout_4.f90 b/gcc/testsuite/gfortran.dg/character_workout_4.f90 new file mode 100644 index 0000000..993c742 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_workout_4.f90 @@ -0,0 +1,689 @@ +! { dg-do run } +! +! Tests fix for PR100120/100816/100818/100819/100821 +! + +program main_p + + implicit none + + integer, parameter :: k = 4 + integer, parameter :: n = 11 + integer, parameter :: m = 7 + integer, parameter :: l = 3 + integer, parameter :: u = 5 + integer, parameter :: e = u-l+1 + integer, parameter :: c = int(z"FF00") + + character(kind=k), target :: c1(n) + character(len=m, kind=k), target :: cm(n) + ! + character(kind=k), pointer :: s1 + character(len=m, kind=k), pointer :: sm + character(len=e, kind=k), pointer :: se + character(len=:, kind=k), pointer :: sd + ! + character(kind=k), pointer :: p1(:) + character(len=m, kind=k), pointer :: pm(:) + character(len=e, kind=k), pointer :: pe(:) + character(len=:, kind=k), pointer :: pd(:) + + class(*), pointer :: su + class(*), pointer :: pu(:) + + integer :: i, j + + nullify(s1, sm, se, sd, su) + nullify(p1, pm, pe, pd, pu) + c1 = [(char(i+c, kind=k), i=1,n)] + do i = 1, n + do j = 1, m + cm(i)(j:j) = char(i*m+j+c-m, kind=k) + end do + end do + + s1 => c1(n) + if(.not.associated(s1)) stop 1 + if(.not.associated(s1, c1(n))) stop 2 + if(len(s1)/=1) stop 3 + if(s1/=c1(n)) stop 4 + call schar_c1(s1) + call schar_a1(s1) + p1 => c1 + if(.not.associated(p1)) stop 5 + if(.not.associated(p1, c1)) stop 6 + if(len(p1)/=1) stop 7 + if(any(p1/=c1)) stop 8 + call achar_c1(p1) + call achar_a1(p1) + ! + sm => cm(n) + if(.not.associated(sm)) stop 9 + if(.not.associated(sm, cm(n))) stop 10 + if(len(sm)/=m) stop 11 + if(sm/=cm(n)) stop 12 + call schar_cm(sm) + call schar_am(sm) + pm => cm + if(.not.associated(pm)) stop 13 + if(.not.associated(pm, cm)) stop 14 + if(len(pm)/=m) stop 15 + if(any(pm/=cm)) stop 16 + call achar_cm(pm) + call achar_am(pm) + ! + se => cm(n)(l:u) + if(.not.associated(se)) stop 17 + if(.not.associated(se, cm(n)(l:u))) stop 18 + if(len(se)/=e) stop 19 + if(se/=cm(n)(l:u)) stop 20 + call schar_ce(se) + call schar_ae(se) + pe => cm(:)(l:u) + if(.not.associated(pe)) stop 21 + if(.not.associated(pe, cm(:)(l:u))) stop 22 + if(len(pe)/=e) stop 23 + if(any(pe/=cm(:)(l:u))) stop 24 + call achar_ce(pe) + call achar_ae(pe) + ! + sd => c1(n) + if(.not.associated(sd)) stop 25 + if(.not.associated(sd, c1(n))) stop 26 + if(len(sd)/=1) stop 27 + if(sd/=c1(n)) stop 28 + call schar_d1(sd) + pd => c1 + if(.not.associated(pd)) stop 29 + if(.not.associated(pd, c1)) stop 30 + if(len(pd)/=1) stop 31 + if(any(pd/=c1)) stop 32 + call achar_d1(pd) + ! + sd => cm(n) + if(.not.associated(sd)) stop 33 + if(.not.associated(sd, cm(n))) stop 34 + if(len(sd)/=m) stop 35 + if(sd/=cm(n)) stop 36 + call schar_dm(sd) + pd => cm + if(.not.associated(pd)) stop 37 + if(.not.associated(pd, cm)) stop 38 + if(len(pd)/=m) stop 39 + if(any(pd/=cm)) stop 40 + call achar_dm(pd) + ! + sd => cm(n)(l:u) + if(.not.associated(sd)) stop 41 + if(.not.associated(sd, cm(n)(l:u))) stop 42 + if(len(sd)/=e) stop 43 + if(sd/=cm(n)(l:u)) stop 44 + call schar_de(sd) + pd => cm(:)(l:u) + if(.not.associated(pd)) stop 45 + if(.not.associated(pd, cm(:)(l:u))) stop 46 + if(len(pd)/=e) stop 47 + if(any(pd/=cm(:)(l:u))) stop 48 + call achar_de(pd) + ! + sd => c1(n) + s1 => sd + if(.not.associated(s1)) stop 49 + if(.not.associated(s1, c1(n))) stop 50 + if(len(s1)/=1) stop 51 + if(s1/=c1(n)) stop 52 + call schar_c1(s1) + call schar_a1(s1) + pd => c1 + s1 => pd(n) + if(.not.associated(s1)) stop 53 + if(.not.associated(s1, c1(n))) stop 54 + if(len(s1)/=1) stop 55 + if(s1/=c1(n)) stop 56 + call schar_c1(s1) + call schar_a1(s1) + pd => c1 + p1 => pd + if(.not.associated(p1)) stop 57 + if(.not.associated(p1, c1)) stop 58 + if(len(p1)/=1) stop 59 + if(any(p1/=c1)) stop 60 + call achar_c1(p1) + call achar_a1(p1) + ! + sd => cm(n) + sm => sd + if(.not.associated(sm)) stop 61 + if(.not.associated(sm, cm(n))) stop 62 + if(len(sm)/=m) stop 63 + if(sm/=cm(n)) stop 64 + call schar_cm(sm) + call schar_am(sm) + pd => cm + sm => pd(n) + if(.not.associated(sm)) stop 65 + if(.not.associated(sm, cm(n))) stop 66 + if(len(sm)/=m) stop 67 + if(sm/=cm(n)) stop 68 + call schar_cm(sm) + call schar_am(sm) + pd => cm + pm => pd + if(.not.associated(pm)) stop 69 + if(.not.associated(pm, cm)) stop 70 + if(len(pm)/=m) stop 71 + if(any(pm/=cm)) stop 72 + call achar_cm(pm) + call achar_am(pm) + ! + sd => cm(n)(l:u) + se => sd + if(.not.associated(se)) stop 73 + if(.not.associated(se, cm(n)(l:u))) stop 74 + if(len(se)/=e) stop 75 + if(se/=cm(n)(l:u)) stop 76 + call schar_ce(se) + call schar_ae(se) + pd => cm(:)(l:u) + pe => pd + if(.not.associated(pe)) stop 77 + if(.not.associated(pe, cm(:)(l:u))) stop 78 + if(len(pe)/=e) stop 79 + if(any(pe/=cm(:)(l:u))) stop 80 + call achar_ce(pe) + call achar_ae(pe) + ! + su => c1(n) + if(.not.associated(su)) stop 81 + if(.not.associated(su, c1(n))) stop 82 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=1) stop 83 + if(su/=c1(n)) stop 84 + class default + stop 85 + end select + call schar_u1(su) + pu => c1 + if(.not.associated(pu)) stop 86 + if(.not.associated(pu, c1)) stop 87 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=1) stop 88 + if(any(pu/=c1)) stop 89 + class default + stop 90 + end select + call achar_u1(pu) + ! + su => cm(n) + if(.not.associated(su)) stop 91 + if(.not.associated(su)) stop 92 + if(.not.associated(su, cm(n))) stop 93 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=m) stop 94 + if(su/=cm(n)) stop 95 + class default + stop 96 + end select + call schar_um(su) + pu => cm + if(.not.associated(pu)) stop 97 + if(.not.associated(pu, cm)) stop 98 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=m) stop 99 + if(any(pu/=cm)) stop 100 + class default + stop 101 + end select + call achar_um(pu) + ! + su => cm(n)(l:u) + if(.not.associated(su)) stop 102 + if(.not.associated(su, cm(n)(l:u))) stop 103 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 104 + if(su/=cm(n)(l:u)) stop 105 + class default + stop 106 + end select + call schar_ue(su) + pu => cm(:)(l:u) + if(.not.associated(pu)) stop 107 + if(.not.associated(pu, cm(:)(l:u))) stop 108 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=e) stop 109 + if(any(pu/=cm(:)(l:u))) stop 110 + class default + stop 111 + end select + call achar_ue(pu) + ! + sd => c1(n) + su => sd + if(.not.associated(su)) stop 112 + if(.not.associated(su, c1(n))) stop 113 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=1) stop 114 + if(su/=c1(n)) stop 115 + class default + stop 116 + end select + call schar_u1(su) + pd => c1 + su => pd(n) + if(.not.associated(su)) stop 117 + if(.not.associated(su, c1(n))) stop 118 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=1) stop 119 + if(su/=c1(n)) stop 120 + class default + stop 121 + end select + call schar_u1(su) + pd => c1 + pu => pd + if(.not.associated(pu)) stop 122 + if(.not.associated(pu, c1)) stop 123 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=1) stop 124 + if(any(pu/=c1)) stop 125 + class default + stop 126 + end select + call achar_u1(pu) + ! + sd => cm(n) + su => sd + if(.not.associated(su)) stop 127 + if(.not.associated(su, cm(n))) stop 128 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=m) stop 129 + if(su/=cm(n)) stop 130 + class default + stop 131 + end select + call schar_um(su) + pd => cm + su => pd(n) + if(.not.associated(su)) stop 132 + if(.not.associated(su, cm(n))) stop 133 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=m) stop 134 + if(su/=cm(n)) stop 135 + class default + stop 136 + end select + call schar_um(su) + pd => cm + pu => pd + if(.not.associated(pu)) stop 137 + if(.not.associated(pu, cm)) stop 138 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=m) stop 139 + if(any(pu/=cm)) stop 140 + class default + stop 141 + end select + call achar_um(pu) + ! + sd => cm(n)(l:u) + su => sd + if(.not.associated(su)) stop 142 + if(.not.associated(su, cm(n)(l:u))) stop 143 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 144 + if(su/=cm(n)(l:u)) stop 145 + class default + stop 146 + end select + call schar_ue(su) + pd => cm(:)(l:u) + su => pd(n) + if(.not.associated(su)) stop 147 + if(.not.associated(su, cm(n)(l:u))) stop 148 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 149 + if(su/=cm(n)(l:u)) stop 150 + class default + stop 151 + end select + call schar_ue(su) + pd => cm(:)(l:u) + pu => pd + if(.not.associated(pu)) stop 152 + if(.not.associated(pu, cm(:)(l:u))) stop 153 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=e) stop 154 + if(any(pu/=cm(:)(l:u))) stop 155 + class default + stop 156 + end select + call achar_ue(pu) + ! + sd => cm(n) + su => sd(l:u) + if(.not.associated(su)) stop 157 + if(.not.associated(su, cm(n)(l:u))) stop 158 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 159 + if(su/=cm(n)(l:u)) stop 160 + class default + stop 161 + end select + call schar_ue(su) + pd => cm(:) + su => pd(n)(l:u) + if(.not.associated(su)) stop 162 + if(.not.associated(su, cm(n)(l:u))) stop 163 + select type(su) + type is(character(len=*, kind=k)) + if(len(su)/=e) stop 164 + if(su/=cm(n)(l:u)) stop 165 + class default + stop 166 + end select + call schar_ue(su) + pd => cm + pu => pd(:)(l:u) + if(.not.associated(pu)) stop 167 + if(.not.associated(pu, cm(:)(l:u))) stop 168 + select type(pu) + type is(character(len=*, kind=k)) + if(len(pu)/=e) stop 169 + if(any(pu/=cm(:)(l:u))) stop 170 + class default + stop 171 + end select + call achar_ue(pu) + ! + stop + +contains + + subroutine schar_c1(a) + character(kind=k), pointer, intent(in) :: a + + if(.not.associated(a)) stop 172 + if(.not.associated(a, c1(n))) stop 173 + if(len(a)/=1) stop 174 + if(a/=c1(n)) stop 175 + return + end subroutine schar_c1 + + subroutine achar_c1(a) + character(kind=k), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 176 + if(.not.associated(a, c1)) stop 177 + if(len(a)/=1) stop 178 + if(any(a/=c1)) stop 179 + return + end subroutine achar_c1 + + subroutine schar_cm(a) + character(kind=k, len=m), pointer, intent(in) :: a + + if(.not.associated(a)) stop 180 + if(.not.associated(a, cm(n))) stop 181 + if(len(a)/=m) stop 182 + if(a/=cm(n)) stop 183 + return + end subroutine schar_cm + + subroutine achar_cm(a) + character(kind=k, len=m), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 184 + if(.not.associated(a, cm)) stop 185 + if(len(a)/=m) stop 186 + if(any(a/=cm)) stop 187 + return + end subroutine achar_cm + + subroutine schar_ce(a) + character(kind=k, len=e), pointer, intent(in) :: a + + if(.not.associated(a)) stop 188 + if(.not.associated(a, cm(n)(l:u))) stop 189 + if(len(a)/=e) stop 190 + if(a/=cm(n)(l:u)) stop 191 + return + end subroutine schar_ce + + subroutine achar_ce(a) + character(kind=k, len=e), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 192 + if(.not.associated(a, cm(:)(l:u))) stop 193 + if(len(a)/=e) stop 194 + if(any(a/=cm(:)(l:u))) stop 195 + return + end subroutine achar_ce + + subroutine schar_a1(a) + character(kind=k, len=*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 196 + if(.not.associated(a, c1(n))) stop 197 + if(len(a)/=1) stop 198 + if(a/=c1(n)) stop 199 + return + end subroutine schar_a1 + + subroutine achar_a1(a) + character(kind=k, len=*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 200 + if(.not.associated(a, c1)) stop 201 + if(len(a)/=1) stop 202 + if(any(a/=c1)) stop 203 + return + end subroutine achar_a1 + + subroutine schar_am(a) + character(kind=k, len=*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 204 + if(.not.associated(a, cm(n))) stop 205 + if(len(a)/=m) stop 206 + if(a/=cm(n)) stop 207 + return + end subroutine schar_am + + subroutine achar_am(a) + character(kind=k, len=*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 208 + if(.not.associated(a, cm)) stop 209 + if(len(a)/=m) stop 210 + if(any(a/=cm)) stop 211 + return + end subroutine achar_am + + subroutine schar_ae(a) + character(kind=k, len=*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 212 + if(.not.associated(a, cm(n)(l:u))) stop 213 + if(len(a)/=e) stop 214 + if(a/=cm(n)(l:u)) stop 215 + return + end subroutine schar_ae + + subroutine achar_ae(a) + character(kind=k, len=*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 216 + if(.not.associated(a, cm(:)(l:u))) stop 217 + if(len(a)/=e) stop 218 + if(any(a/=cm(:)(l:u))) stop 219 + return + end subroutine achar_ae + + subroutine schar_d1(a) + character(kind=k, len=:), pointer, intent(in) :: a + + if(.not.associated(a)) stop 220 + if(.not.associated(a, c1(n))) stop 221 + if(len(a)/=1) stop 222 + if(a/=c1(n)) stop 223 + return + end subroutine schar_d1 + + subroutine achar_d1(a) + character(kind=k, len=:), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 224 + if(.not.associated(a, c1)) stop 225 + if(len(a)/=1) stop 226 + if(any(a/=c1)) stop 227 + return + end subroutine achar_d1 + + subroutine schar_dm(a) + character(kind=k, len=:), pointer, intent(in) :: a + + if(.not.associated(a)) stop 228 + if(.not.associated(a, cm(n))) stop 229 + if(len(a)/=m) stop 230 + if(a/=cm(n)) stop 231 + return + end subroutine schar_dm + + subroutine achar_dm(a) + character(kind=k, len=:), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 232 + if(.not.associated(a, cm)) stop 233 + if(len(a)/=m) stop 234 + if(any(a/=cm)) stop 235 + return + end subroutine achar_dm + + subroutine schar_de(a) + character(kind=k, len=:), pointer, intent(in) :: a + + if(.not.associated(a)) stop 236 + if(.not.associated(a, cm(n)(l:u))) stop 237 + if(len(a)/=e) stop 238 + if(a/=cm(n)(l:u)) stop 239 + return + end subroutine schar_de + + subroutine achar_de(a) + character(kind=k, len=:), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 240 + if(.not.associated(a, cm(:)(l:u))) stop 241 + if(len(a)/=e) stop 242 + if(any(a/=cm(:)(l:u))) stop 243 + return + end subroutine achar_de + + subroutine schar_u1(a) + class(*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 244 + if(.not.associated(a, c1(n))) stop 245 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=1) stop 246 + if(a/=c1(n)) stop 247 + class default + stop 248 + end select + return + end subroutine schar_u1 + + subroutine achar_u1(a) + class(*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 249 + if(.not.associated(a, c1)) stop 250 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=1) stop 251 + if(any(a/=c1)) stop 252 + class default + stop 253 + end select + return + end subroutine achar_u1 + + subroutine schar_um(a) + class(*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 254 + if(.not.associated(a)) stop 255 + if(.not.associated(a, cm(n))) stop 256 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=m) stop 257 + if(a/=cm(n)) stop 258 + class default + stop 259 + end select + return + end subroutine schar_um + + subroutine achar_um(a) + class(*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 260 + if(.not.associated(a, cm)) stop 261 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=m) stop 262 + if(any(a/=cm)) stop 263 + class default + stop 264 + end select + return + end subroutine achar_um + + subroutine schar_ue(a) + class(*), pointer, intent(in) :: a + + if(.not.associated(a)) stop 265 + if(.not.associated(a, cm(n)(l:u))) stop 266 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=e) stop 267 + if(a/=cm(n)(l:u)) stop 268 + class default + stop 269 + end select + return + end subroutine schar_ue + + subroutine achar_ue(a) + class(*), pointer, intent(in) :: a(:) + + if(.not.associated(a)) stop 270 + if(.not.associated(a, cm(:)(l:u))) stop 271 + select type(a) + type is(character(len=*, kind=k)) + if(len(a)/=e) stop 272 + if(any(a/=cm(:)(l:u))) stop 273 + class default + stop 274 + end select + return + end subroutine achar_ue + +end program main_p -- cgit v1.1 From 9147affc04e1188a385748ad0f51eb7491a792ab Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:21:04 -0500 Subject: m68k: Update unexpected empty split condition gcc/ChangeLog: * config/m68k/m68k.md (*zero_extend_inc, *zero_extend_dec, *zero_extendsidi2): Fix empty split condition. --- gcc/config/m68k/m68k.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/config/m68k/m68k.md b/gcc/config/m68k/m68k.md index 59a456c..82d075e 100644 --- a/gcc/config/m68k/m68k.md +++ b/gcc/config/m68k/m68k.md @@ -1693,7 +1693,7 @@ GET_MODE_CLASS (GET_MODE (operands[1])) == MODE_INT && GET_MODE_SIZE (GET_MODE (operands[0])) == GET_MODE_SIZE (GET_MODE (operands[1])) * 2" "#" - "" + "&& 1" [(set (match_dup 0) (const_int 0)) (set (match_dup 0) @@ -1710,7 +1710,7 @@ GET_MODE_CLASS (GET_MODE (operands[1])) == MODE_INT && GET_MODE_SIZE (GET_MODE (operands[0])) == GET_MODE_SIZE (GET_MODE (operands[1])) * 2" "#" - "" + "&& 1" [(set (match_dup 0) (match_dup 1)) (set (match_dup 0) @@ -1764,7 +1764,7 @@ (zero_extend:DI (match_operand:SI 1 "nonimmediate_src_operand" "")))] "GET_CODE (operands[0]) != MEM || GET_CODE (operands[1]) != MEM" "#" - "" + "&& 1" [(set (match_dup 2) (match_dup 1)) (set (match_dup 3) -- cgit v1.1 From bdce6760c2098558cbf9c89e166ddb172ec56cc7 Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:21:07 -0500 Subject: mips: Update unexpected empty split condition gcc/ChangeLog: * config/mips/mips.md (, bswapsi2, bswapdi2): Fix empty split condition. --- gcc/config/mips/mips.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/config/mips/mips.md b/gcc/config/mips/mips.md index eef3cfd..455b9b8 100644 --- a/gcc/config/mips/mips.md +++ b/gcc/config/mips/mips.md @@ -5835,7 +5835,7 @@ (match_operand:SI 2 "immediate_operand" "I")))] "TARGET_MIPS16" "#" - "" + "&& 1" [(set (match_dup 0) (match_dup 1)) (set (match_dup 0) (lshiftrt:SI (match_dup 0) (match_dup 2)))] "" @@ -5871,7 +5871,7 @@ (bswap:SI (match_operand:SI 1 "register_operand" "d")))] "ISA_HAS_WSBH && ISA_HAS_ROR" "#" - "" + "&& 1" [(set (match_dup 0) (unspec:SI [(match_dup 1)] UNSPEC_WSBH)) (set (match_dup 0) (rotatert:SI (match_dup 0) (const_int 16)))] "" @@ -5882,7 +5882,7 @@ (bswap:DI (match_operand:DI 1 "register_operand" "d")))] "TARGET_64BIT && ISA_HAS_WSBH" "#" - "" + "&& 1" [(set (match_dup 0) (unspec:DI [(match_dup 1)] UNSPEC_DSBH)) (set (match_dup 0) (unspec:DI [(match_dup 0)] UNSPEC_DSHD))] "" -- cgit v1.1 From 8afd2e822903b3df63e69bb04a2aa533047ceb01 Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:21:11 -0500 Subject: or1k: Update unexpected empty split condition gcc/ChangeLog: * config/or1k/or1k.md (*movdi): Fix empty split condition. --- gcc/config/or1k/or1k.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/config/or1k/or1k.md b/gcc/config/or1k/or1k.md index eb94efb..495b3e2 100644 --- a/gcc/config/or1k/or1k.md +++ b/gcc/config/or1k/or1k.md @@ -351,7 +351,7 @@ "register_operand (operands[0], DImode) || reg_or_0_operand (operands[1], DImode)" "#" - "" + "&& 1" [(const_int 0)] { rtx l0 = operand_subword (operands[0], 0, 0, DImode); -- cgit v1.1 From 10f36fe50cb3cb75d17903df116719ee2f4e492c Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:21:18 -0500 Subject: sparc: Update unexpected empty split condition gcc/ChangeLog: * config/sparc/sparc.md (*snedi_zero_vis3, *neg_snedi_zero_subxc, *plus_snedi_zero, *plus_plus_snedi_zero, *minus_snedi_zero, *minus_minus_snedi_zero): Fix empty split condition. --- gcc/config/sparc/sparc.md | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'gcc') diff --git a/gcc/config/sparc/sparc.md b/gcc/config/sparc/sparc.md index a8d9962..24b76e0 100644 --- a/gcc/config/sparc/sparc.md +++ b/gcc/config/sparc/sparc.md @@ -855,7 +855,7 @@ (clobber (reg:CCX CC_REG))] "TARGET_ARCH64 && TARGET_VIS3" "#" - "" + "&& 1" [(set (reg:CCXC CC_REG) (compare:CCXC (not:DI (match_dup 1)) (const_int -1))) (set (match_dup 0) (ltu:W (reg:CCXC CC_REG) (const_int 0)))] "" @@ -882,7 +882,7 @@ (clobber (reg:CCX CC_REG))] "TARGET_ARCH64 && TARGET_SUBXC" "#" - "" + "&& 1" [(set (reg:CCXC CC_REG) (compare:CCXC (not:DI (match_dup 1)) (const_int -1))) (set (match_dup 0) (neg:W (ltu:W (reg:CCXC CC_REG) (const_int 0))))] "" @@ -984,7 +984,7 @@ (clobber (reg:CCX CC_REG))] "TARGET_ARCH64 && TARGET_VIS3" "#" - "" + "&& 1" [(set (reg:CCXC CC_REG) (compare:CCXC (not:DI (match_dup 1)) (const_int -1))) (set (match_dup 0) (plus:W (ltu:W (reg:CCXC CC_REG) (const_int 0)) (match_dup 2)))] @@ -1000,7 +1000,7 @@ (clobber (reg:CCX CC_REG))] "TARGET_ARCH64 && TARGET_VIS3" "#" - "" + "&& 1" [(set (reg:CCXC CC_REG) (compare:CCXC (not:DI (match_dup 1)) (const_int -1))) (set (match_dup 0) (plus:W (plus:W (ltu:W (reg:CCXC CC_REG) (const_int 0)) (match_dup 2)) @@ -1048,7 +1048,7 @@ (clobber (reg:CCX CC_REG))] "TARGET_ARCH64 && TARGET_SUBXC" "#" - "" + "&& 1" [(set (reg:CCXC CC_REG) (compare:CCXC (not:DI (match_dup 1)) (const_int -1))) (set (match_dup 0) (minus:W (match_dup 2) (ltu:W (reg:CCXC CC_REG) (const_int 0))))] @@ -1064,7 +1064,7 @@ (clobber (reg:CCX CC_REG))] "TARGET_ARCH64 && TARGET_SUBXC" "#" - "" + "&& 1" [(set (reg:CCXC CC_REG) (compare:CCXC (not:DI (match_dup 1)) (const_int -1))) (set (match_dup 0) (minus:W (minus:W (match_dup 2) (ltu:W (reg:CCXC CC_REG) (const_int 0))) -- cgit v1.1 From 081c9dfb67a0d2e7425ddb5420ada588026f92ca Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Fri, 28 May 2021 00:21:14 -0500 Subject: sh: Update unexpected empty split condition gcc/ChangeLog: * config/sh/sh.md (doloop_end_split): Fix empty split condition. --- gcc/config/sh/sh.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/config/sh/sh.md b/gcc/config/sh/sh.md index e3af9ae..93ee7c9 100644 --- a/gcc/config/sh/sh.md +++ b/gcc/config/sh/sh.md @@ -6424,7 +6424,7 @@ (clobber (reg:SI T_REG))] "TARGET_SH2" "#" - "" + "&& 1" [(parallel [(set (reg:SI T_REG) (eq:SI (match_dup 2) (const_int 1))) (set (match_dup 0) (plus:SI (match_dup 2) (const_int -1)))]) -- cgit v1.1 From 28c62475050d2ac6c243580e1130a87308e1e907 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sun, 6 Jun 2021 00:16:22 +0000 Subject: Daily bump. --- gcc/ChangeLog | 41 +++++++++++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/fortran/ChangeLog | 34 ++++++++++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 11 +++++++++++ 4 files changed, 87 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ChangeLog b/gcc/ChangeLog index e94b2fc..d78b97c 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,44 @@ +2021-06-05 Kewen Lin + + * config/sh/sh.md (doloop_end_split): Fix empty split condition. + +2021-06-05 Kewen Lin + + * config/sparc/sparc.md (*snedi_zero_vis3, + *neg_snedi_zero_subxc, *plus_snedi_zero, + *plus_plus_snedi_zero, *minus_snedi_zero, + *minus_minus_snedi_zero): Fix empty split condition. + +2021-06-05 Kewen Lin + + * config/or1k/or1k.md (*movdi): Fix empty split condition. + +2021-06-05 Kewen Lin + + * config/mips/mips.md (, bswapsi2, bswapdi2): Fix empty + split condition. + +2021-06-05 Kewen Lin + + * config/m68k/m68k.md (*zero_extend_inc, *zero_extend_dec, + *zero_extendsidi2): Fix empty split condition. + +2021-06-05 Jeff Law + + * config/h8300/addsub.md: Fix split condition in define_insn_and_split + patterns. + * config/h8300/bitfield.md: Likewise. + * config/h8300/combiner.md: Likewise. + * config/h8300/divmod.md: Likewise. + * config/h8300/extensions.md: Likewise. + * config/h8300/jumpcall.md: Likewise. + * config/h8300/movepush.md: Likewise. + * config/h8300/multiply.md: Likewise. + * config/h8300/other.md: Likewise. + * config/h8300/shiftrotate.md: Likewise. + * config/h8300/logical.md: Likewise. Fix split pattern to use + code iterator that somehow slipped through. + 2021-06-04 Tobias Burnus PR middle-end/100905 diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 0098130..09dbf4d 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20210605 +20210606 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 33ab58a..12b932f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,37 @@ +2021-06-05 José Rui Faustino de Sousa + + PR fortran/100120 + PR fortran/100816 + PR fortran/100818 + PR fortran/100819 + PR fortran/100821 + * trans-array.c (gfc_get_array_span): rework the way character + array "span" was calculated. + (gfc_conv_expr_descriptor): improve handling of character sections + and unlimited polymorphic objects. + * trans-expr.c (gfc_get_character_len): new function to calculate + character string length. + (gfc_get_character_len_in_bytes): new function to calculate + character string length in bytes. + (gfc_conv_scalar_to_descriptor): add call to set the "span". + (gfc_trans_pointer_assignment): set "_len" and antecipate the + initialization of the deferred character length hidden argument. + * trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to + avoid the creation of a temporary. + * trans-types.c (gfc_get_dtype_rank_type): rework type detection + so that unlimited polymorphic objects get proper type infomation, + also important for bind(c). + (gfc_get_dtype): add argument to pass the rank if necessary. + (gfc_get_array_type_bounds): cosmetic change to have character + arrays called character instead of unknown. + * trans-types.h (gfc_get_dtype): modify prototype. + * trans.c (get_array_span): rework the way character array "span" + was calculated. + * trans.h (gfc_get_character_len): new prototype. + (gfc_get_character_len_in_bytes): new prototype. + Add "unlimited_polymorphic" flag to "gfc_se" type to signal when + expression carries an unlimited polymorphic object. + 2021-06-04 Harald Anlauf PR fortran/99839 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ba1d2c7..5e19bb9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2021-06-05 José Rui Faustino de Sousa + + PR fortran/100120 + PR fortran/100816 + PR fortran/100818 + PR fortran/100819 + PR fortran/100821 + * gfortran.dg/PR100120.f90: New test. + * gfortran.dg/character_workout_1.f90: New test. + * gfortran.dg/character_workout_4.f90: New test. + 2021-06-04 Tobias Burnus PR middle-end/100905 -- cgit v1.1 From a589877a0036fc2f66b7a957859940c53efdc7c9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 6 Jun 2021 11:37:45 +0200 Subject: Fix thinko in new warning on type punning for storage order purposes In C, unlike in Ada, the storage order of arrays is that of their component type, so you need to look at it when deciding to warn. And the PR complains about a bogus warning on the assignment of a pointer returned by alloca or malloc, so this also fixes that. gcc/c PR c/100920 * c-decl.c (finish_struct): Fix thinko in previous change. * c-typeck.c (convert_for_assignment): Do not warn on pointer assignment and initialization for storage order purposes if the RHS is a call to a DECL_IS_MALLOC function. gcc/testsuite/ * gcc.dg/sso-14.c: New test. --- gcc/c/c-decl.c | 19 ++++++++++++---- gcc/c/c-typeck.c | 23 ++++++++++++++----- gcc/testsuite/gcc.dg/sso-14.c | 53 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 84 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/sso-14.c (limited to 'gcc') diff --git a/gcc/c/c-decl.c b/gcc/c/c-decl.c index 28f851b..a86792b 100644 --- a/gcc/c/c-decl.c +++ b/gcc/c/c-decl.c @@ -8854,12 +8854,21 @@ finish_struct (location_t loc, tree t, tree fieldlist, tree attributes, } } + /* Warn on problematic type punning for storage order purposes. */ if (TREE_CODE (t) == UNION_TYPE - && AGGREGATE_TYPE_P (TREE_TYPE (field)) - && TYPE_REVERSE_STORAGE_ORDER (t) - != TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (field))) - warning_at (DECL_SOURCE_LOCATION (field), OPT_Wscalar_storage_order, - "type punning toggles scalar storage order"); + && TREE_CODE (field) == FIELD_DECL + && AGGREGATE_TYPE_P (TREE_TYPE (field))) + { + tree ftype = TREE_TYPE (field); + if (TREE_CODE (ftype) == ARRAY_TYPE) + ftype = strip_array_types (ftype); + if (RECORD_OR_UNION_TYPE_P (ftype) + && TYPE_REVERSE_STORAGE_ORDER (ftype) + != TYPE_REVERSE_STORAGE_ORDER (t)) + warning_at (DECL_SOURCE_LOCATION (field), + OPT_Wscalar_storage_order, + "type punning toggles scalar storage order"); + } } /* Now we have the truly final field list. diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c index be3f4f0..daa2e12 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -7295,6 +7295,8 @@ convert_for_assignment (location_t location, location_t expr_loc, tree type, && (AGGREGATE_TYPE_P (ttl) && TYPE_REVERSE_STORAGE_ORDER (ttl)) != (AGGREGATE_TYPE_P (ttr) && TYPE_REVERSE_STORAGE_ORDER (ttr))) { + tree t; + switch (errtype) { case ic_argpass: @@ -7307,14 +7309,23 @@ convert_for_assignment (location_t location, location_t expr_loc, tree type, "scalar storage order", parmnum, rname); break; case ic_assign: - warning_at (location, OPT_Wscalar_storage_order, - "assignment to %qT from pointer type %qT with " - "incompatible scalar storage order", type, rhstype); + /* Do not warn if the RHS is a call to a function that returns a + pointer that is not an alias. */ + if (TREE_CODE (rhs) != CALL_EXPR + || (t = get_callee_fndecl (rhs)) == NULL_TREE + || !DECL_IS_MALLOC (t)) + warning_at (location, OPT_Wscalar_storage_order, + "assignment to %qT from pointer type %qT with " + "incompatible scalar storage order", type, rhstype); break; case ic_init: - warning_at (location, OPT_Wscalar_storage_order, - "initialization of %qT from pointer type %qT with " - "incompatible scalar storage order", type, rhstype); + /* Likewise. */ + if (TREE_CODE (rhs) != CALL_EXPR + || (t = get_callee_fndecl (rhs)) == NULL_TREE + || !DECL_IS_MALLOC (t)) + warning_at (location, OPT_Wscalar_storage_order, + "initialization of %qT from pointer type %qT with " + "incompatible scalar storage order", type, rhstype); break; case ic_return: warning_at (location, OPT_Wscalar_storage_order, diff --git a/gcc/testsuite/gcc.dg/sso-14.c b/gcc/testsuite/gcc.dg/sso-14.c new file mode 100644 index 0000000..af98145 --- /dev/null +++ b/gcc/testsuite/gcc.dg/sso-14.c @@ -0,0 +1,53 @@ +/* PR c/100920 */ +/* Testcase by George Thopas */ + +/* { dg-do compile } */ + +#include +#include + +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ +#define REV_ENDIANNESS __attribute__((scalar_storage_order("big-endian"))) +#else +#define REV_ENDIANNESS __attribute__((scalar_storage_order("little-endian"))) +#endif + +struct s_1 { + int val; +} REV_ENDIANNESS; + +typedef struct s_1 t_1; + +struct s_2 { + char val; +} REV_ENDIANNESS; + +typedef struct s_2 t_2; + +struct s12 { + t_1 a[1]; + t_2 b[1]; +} REV_ENDIANNESS; + +typedef struct s12 t_s12; + +union u12 { + t_1 a[1]; + t_2 b[1]; +} REV_ENDIANNESS; + +typedef union u12 t_u12; + +int main(void) +{ + t_s12 *msg1 = __builtin_alloca(10); + t_u12 *msg2 = __builtin_alloca(10); + + msg1 = malloc (sizeof (t_s12)); + msg2 = malloc (sizeof (t_u12)); + + msg1->a[0].val = 0; + msg2->a[0].val = 0; + + return 0; +} -- cgit v1.1 From 4e65bf5ace0437e1c5f182dba056d846829c0c33 Mon Sep 17 00:00:00 2001 From: Martin Liska Date: Sun, 6 Jun 2021 16:56:18 +0200 Subject: docs: remove extra character. gcc/ChangeLog: * doc/invoke.texi: Remove extra character. --- gcc/doc/invoke.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index eb8142f..7102999 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -20105,7 +20105,7 @@ For some ARM implementations better performance can be obtained by using this option. Permissible names are: @samp{arm7tdmi}, @samp{arm7tdmi-s}, @samp{arm710t}, @samp{arm720t}, @samp{arm740t}, @samp{strongarm}, @samp{strongarm110}, -@samp{strongarm1100}, 0@samp{strongarm1110}, @samp{arm8}, @samp{arm810}, +@samp{strongarm1100}, @samp{strongarm1110}, @samp{arm8}, @samp{arm810}, @samp{arm9}, @samp{arm9e}, @samp{arm920}, @samp{arm920t}, @samp{arm922t}, @samp{arm946e-s}, @samp{arm966e-s}, @samp{arm968e-s}, @samp{arm926ej-s}, @samp{arm940t}, @samp{arm9tdmi}, @samp{arm10tdmi}, @samp{arm1020t}, -- cgit v1.1