diff options
| author | Martin Liska <mliska@suse.cz> | 2021-06-06 16:57:23 +0200 |
|---|---|---|
| committer | Martin Liska <mliska@suse.cz> | 2021-06-06 16:57:23 +0200 |
| commit | 6de742a6dbb1d5fbcdd456856d8b8bd92570ea0c (patch) | |
| tree | b656042f5b4421ab2952b0ec0035aeb023180fdc /gcc | |
| parent | d67627857ce27d607c691308aa2b816aabb6cb32 (diff) | |
| parent | 4e65bf5ace0437e1c5f182dba056d846829c0c33 (diff) | |
| download | gcc-6de742a6dbb1d5fbcdd456856d8b8bd92570ea0c.zip gcc-6de742a6dbb1d5fbcdd456856d8b8bd92570ea0c.tar.gz gcc-6de742a6dbb1d5fbcdd456856d8b8bd92570ea0c.tar.bz2 | |
Merge branch 'master' into devel/sphinx
Diffstat (limited to 'gcc')
101 files changed, 4670 insertions, 403 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 06e6dbe..d78b97c 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,122 @@ +2021-06-05 Kewen Lin <linkw@linux.ibm.com> + + * config/sh/sh.md (doloop_end_split): Fix empty split condition. + +2021-06-05 Kewen Lin <linkw@linux.ibm.com> + + * config/sparc/sparc.md (*snedi<W:mode>_zero_vis3, + *neg_snedi<W:mode>_zero_subxc, *plus_snedi<W:mode>_zero, + *plus_plus_snedi<W:mode>_zero, *minus_snedi<W:mode>_zero, + *minus_minus_snedi<W:mode>_zero): Fix empty split condition. + +2021-06-05 Kewen Lin <linkw@linux.ibm.com> + + * config/or1k/or1k.md (*movdi): Fix empty split condition. + +2021-06-05 Kewen Lin <linkw@linux.ibm.com> + + * config/mips/mips.md (<anonymous>, bswapsi2, bswapdi2): Fix empty + split condition. + +2021-06-05 Kewen Lin <linkw@linux.ibm.com> + + * config/m68k/m68k.md (*zero_extend_inc, *zero_extend_dec, + *zero_extendsidi2): Fix empty split condition. + +2021-06-05 Jeff Law <jeffreyalaw@gmail.com> + + * 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 <tobias@codesourcery.com> + + PR middle-end/100905 + * tree-nested.c (convert_nonlocal_omp_clauses, + convert_local_omp_clauses): Handle OMP_CLAUSE_BIND. + +2021-06-04 Martin Sebor <msebor@redhat.com> + + 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 <msebor@redhat.com> + + * 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 <ubizjak@gmail.com> + + * config/i386/predicates.md (GOT_memory_operand): + Implement using match_code RTXes. + (GOT32_symbol_operand): Ditto. + +2021-06-04 Uroš Bizjak <ubizjak@gmail.com> + + 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 <linkw@linux.ibm.com> + + * config/arm/vfp.md (no_literal_pool_df_immediate, + no_literal_pool_sf_immediate): Fix empty split condition. + +2021-06-04 Kewen Lin <linkw@linux.ibm.com> + + * 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 (*<sse2_avx2>_pmovmskb_lt, + *<sse2_avx2>_pmovmskb_zext_lt, *sse2_pmovmskb_ext_lt, + *<sse4_1_avx2>_pblendvb_lt): Likewise. + +2021-06-04 Jakub Jelinek <jakub@redhat.com> + + 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 <claziss@synopsys.com> + + * config/arc/arc.c (arc_override_options): Disable millicode + thunks when RF16 is on. + +2021-06-04 Haochen Gui <guihaoc@gcc.gnu.org> + + * config/rs6000/rs6000.h (PROMOTE_MODE): Remove. + +2021-06-04 Haochen Gui <guihaoc@gcc.gnu.org> + + * config/rs6000/rs6000-call.c (rs6000_promote_function_mode): + Replace PROMOTE_MODE marco with its content. + 2021-06-03 Kewen Lin <linkw@linux.ibm.com> * config/cris/cris.md (*addi_reload): Fix empty split condition. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 8da0c6d..09dbf4d 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20210604 +20210606 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/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 <msebor@redhat.com> + + PR c/100783 + * c-attribs.c (positional_argument): Bail on erroneous types. + +2021-06-04 Martin Sebor <msebor@redhat.com> + + * c-warn.c (warn_parm_array_mismatch): Check TREE_PURPOSE to test + for element presence. + 2021-06-03 Eric Botcazou <ebotcazou@adacore.com> * c-ada-spec.c (dump_ada_macros): Minor tweaks. 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-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/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 <msebor@redhat.com> + + PR c/100783 + * c-objc-common.c (print_type): Handle erroneous types. + 2021-06-03 Jakub Jelinek <jakub@redhat.com> PR c++/100859 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-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/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/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; 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<X,J,rQi")))] "TARGET_H8300SX && h8300_operands_match_p (operands)" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (plus:HI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -117,7 +117,7 @@ (match_operand:SI 2 "h8300_src_operand" "i,rQ")))] "h8300_operands_match_p (operands)" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (plus:SI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -150,7 +150,7 @@ (match_operand:QI 2 "h8300_dst_operand" "rQ")))] "h8300_operands_match_p (operands)" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (minus:QI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -169,7 +169,7 @@ (match_operand:HSI 2 "h8300_src_operand" "rQ,i")))] "h8300_operands_match_p (operands)" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (minus:HSI (match_dup 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -203,7 +203,7 @@ (neg:QHSI (match_operand:QHSI 1 "h8300_dst_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (neg:QHSI (match_dup 1))) (clobber (reg:CC CC_REG))])]) @@ -228,7 +228,7 @@ (neg:SF (match_operand:SF 1 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (neg:SF (match_dup 1))) (clobber (reg:CC CC_REG))])]) diff --git a/gcc/config/h8300/bitfield.md b/gcc/config/h8300/bitfield.md index 722c147..82cb161 100644 --- a/gcc/config/h8300/bitfield.md +++ b/gcc/config/h8300/bitfield.md @@ -24,7 +24,7 @@ "(TARGET_H8300SX) && (1 << INTVAL (operands[2])) == INTVAL (operands[3])" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:HI (xor:HI (match_dup 1) (match_dup 3)) (const_int 1) @@ -54,7 +54,7 @@ (match_operand 2 "const_int_operand" "n,n")))] "INTVAL (operands[2]) < 16" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:SI (match_dup 1) (const_int 1) (match_dup 2))) (clobber (reg:CC CC_REG))])]) @@ -84,7 +84,7 @@ "INTVAL (operands[2]) < 16 && (1 << INTVAL (operands[2])) == INTVAL (operands[3])" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:SI (xor:SI (match_dup 1) (match_dup 3)) (const_int 1) @@ -159,7 +159,7 @@ (match_operand:HI 2 "register_operand" "r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:HI (match_dup 0) (const_int 1) (match_dup 1)) (match_dup 2)) (clobber (reg:CC CC_REG))])]) @@ -231,7 +231,7 @@ (match_operand:HI 3 "bit_operand" "0")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 4 [(zero_extract:HI (match_dup 1) (const_int 1) @@ -262,7 +262,7 @@ (match_operand:HI 4 "immediate_operand" "n"))]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 5 [(zero_extract:HI (match_dup 1) (const_int 1) @@ -293,7 +293,7 @@ (match_operand:QI 3 "immediate_operand" "n")))] "TARGET_H8300SX && INTVAL (operands[2]) + INTVAL (operands[3]) <= 8" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:QI (match_dup 1) (match_dup 2) (match_dup 3))) (clobber (reg:CC CC_REG))])]) @@ -319,7 +319,7 @@ (match_operand:QI 1 "register_operand" "r"))] "TARGET_H8300SX && INTVAL (operands[2]) + INTVAL (operands[3]) <= 8" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:QI (match_dup 0) (match_dup 2) (match_dup 3)) (match_dup 1)) (clobber (reg:CC CC_REG))])]) diff --git a/gcc/config/h8300/combiner.md b/gcc/config/h8300/combiner.md index 20e19da..067f266 100644 --- a/gcc/config/h8300/combiner.md +++ b/gcc/config/h8300/combiner.md @@ -11,7 +11,7 @@ (match_operand:SI 2 "register_operand" "r"))] "INTVAL (operands[1]) < 16" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:SI (match_dup 0) (const_int 1) (match_dup 1)) (match_dup 2)) (clobber (reg:CC CC_REG))])]) @@ -34,7 +34,7 @@ (match_operand:SI 3 "const_int_operand" "n")))] "INTVAL (operands[1]) < 16 && INTVAL (operands[3]) < 16" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:SI (match_dup 0) (const_int 1) (match_dup 1)) (lshiftrt:SI (match_dup 2) (match_dup 3))) (clobber (reg:CC CC_REG))])]) @@ -58,7 +58,7 @@ (const_int 16)))] "INTVAL (operands[1]) < 16" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:SI (match_dup 0) (const_int 1) (match_dup 1)) (lshiftrt:SI (match_dup 2) (const_int 16))) (clobber (reg:CC CC_REG))])]) @@ -81,7 +81,7 @@ (match_operand:SI 1 "register_operand" "r"))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:SI (match_dup 0) (const_int 8) (const_int 8)) (match_dup 1)) (clobber (reg:CC CC_REG))])]) @@ -104,7 +104,7 @@ (const_int 8)))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (zero_extract:SI (match_dup 0) (const_int 8) (const_int 8)) (lshiftrt:SI (match_dup 1) (const_int 8))) (clobber (reg:CC CC_REG))])]) @@ -129,7 +129,7 @@ (const_int 8)))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:SI (match_dup 1) (const_int 8) (const_int 8))) (clobber (reg:CC CC_REG))])]) @@ -153,7 +153,7 @@ (const_int 16)))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:SI (match_dup 1) (const_int 8) (const_int 16))) (clobber (reg:CC CC_REG))])]) @@ -176,7 +176,7 @@ (clobber (match_scratch:SI 2 "=&r"))] "TARGET_H8300H" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (zero_extract:SI (match_dup 1) (const_int 16) (const_int 8))) (clobber (reg:CC CC_REG))])]) @@ -271,7 +271,7 @@ "exact_log2 (INTVAL (operands[3])) < 16 && INTVAL (operands[2]) + exact_log2 (INTVAL (operands[3])) == 31" "#" - "" + "&& reload_completed" [(parallel [(set (match_dup 0) (and:SI (lshiftrt:SI (match_dup 1) (match_dup 2)) (match_dup 3))) @@ -318,7 +318,7 @@ (match_operand:SI 2 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (plus:SI (mult:SI (match_dup 1) (const_int 65536)) (match_dup 2))) @@ -341,7 +341,7 @@ (zero_extend:SI (match_operand:HI 2 "register_operand" "0"))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (plus:SI (lshiftrt:SI (match_dup 1) (const_int 16)) (zero_extend:SI (match_dup 2)))) @@ -416,7 +416,7 @@ (match_operand:HI 3 "register_operand" "0")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 1 [(zero_extend:HI (match_dup 2)) (match_dup 3)])) @@ -442,7 +442,7 @@ (match_operand:SI 3 "register_operand" "0")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 1 [(zero_extend:SI (match_dup 2)) (match_dup 3)])) @@ -465,7 +465,7 @@ (match_operand:SI 3 "register_operand" "0")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 1 [(zero_extend:SI (match_dup 2)) (match_dup 3)])) @@ -489,7 +489,7 @@ (match_operand:SI 3 "register_operand" "0")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 1 [(ashift:SI (match_dup 2) (const_int 16)) (match_dup 3)])) @@ -514,7 +514,7 @@ (match_operand:SI 3 "register_operand" "0")]))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (match_op_dup 1 [(lshiftrt:SI (match_dup 2) (const_int 16)) (match_dup 3)])) @@ -540,7 +540,7 @@ (match_operand:HI 2 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:HI (ashift:HI (match_dup 1) (const_int 8)) (match_dup 2))) @@ -563,7 +563,7 @@ (match_operand:HI 2 "register_operand" "0")))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:HI (lshiftrt:HI (match_dup 1) (const_int 8)) (match_dup 2))) @@ -586,7 +586,7 @@ (const_int 8))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:HI (zero_extend:HI (match_dup 1)) (ashift:HI (match_dup 2) (const_int 8)))) @@ -609,7 +609,7 @@ (const_int 8))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:HI (zero_extend:HI (match_dup 1)) (ashift:HI (subreg:HI (match_dup 2) 0) @@ -648,7 +648,7 @@ (const_int 16))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (zero_extend:SI (match_dup 1)) (ashift:SI (match_dup 2) (const_int 16)))) @@ -692,7 +692,7 @@ (const_int 16))))] "" "#" - "reload_completed" + "&& reload_completed" [(parallel [(set (match_dup 0) (ior:SI (and:SI (match_dup 1) (const_int -65536)) (lshiftrt:SI (match_dup 2) (const_int 16)))) @@ -735,7 +735,7 @@ (zero_extend:SI (match_operand:QI 2 "general_operand_src" "r,g>"))))] "" "#" - "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 "*<code><mode>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))])]) diff --git a/gcc/config/i386/i386-expand.c b/gcc/config/i386/i386-expand.c index eb7cdb0..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)); @@ -14610,11 +14627,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); @@ -19544,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 (); @@ -19754,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 (); @@ -20263,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) @@ -20294,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/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/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/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" 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))] 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) 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))] "" 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); 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)))]) 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))) 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 <ppalka@redhat.com> + + 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 <ppalka@redhat.com> + + PR c++/100102 + * pt.c (tsubst_function_decl): Remove old code for reducing + args when it has excess levels. + +2021-06-04 Jakub Jelinek <jakub@redhat.com> + + 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 <ppalka@redhat.com> PR c++/100592 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/cp/pt.c b/gcc/cp/pt.c index 7211bdc..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); @@ -13905,45 +13909,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 <class T> struct S { template <class U> void f(); } - template <> template <class U> void S<int>::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 <class T> struct S { - template <class U> friend void f(); - }; - template <class U> void f() {} - template S<int>; - template void f<double>(); - - 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 <class T> struct S { template <class U> void f(U); } - template <class T> template <> void S<T>::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/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 <ibuclaw@gdcproject.org> + + 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 <ibuclaw@gdcproject.org> * d-incpath.cc (prefixed_path): Use filename_ncmp instead of strncmp. 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/doc/invoke.texi b/gcc/doc/invoke.texi index b0d17ef..7070b3c 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -20068,7 +20068,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}, diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bab25eb..12b932f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,96 @@ +2021-06-05 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + 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 <anlauf@gmx.de> + + 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 <tobias@codesourcery.com> + + * dump-parse-tree.c (show_code_node): Handle + EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + * 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 <tobias@codesourcery.com> + + PR middle-end/99928 + * openmp.c (gfc_match_omp_clauses): Fix typo in error message. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + 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 <tobias@codesourcery.com> PR middle-end/99928 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 0e7fe1c..141101e 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; @@ -3191,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: @@ -3198,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: @@ -3214,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: @@ -3232,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; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index e3b1d15..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 @@ -5542,6 +5555,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 +5581,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 +5596,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 +5611,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..638a823 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 THREAD 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/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/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-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-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-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<constructor_elt, va_gc> *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 cbbfcd9..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 @@ -2168,6 +2154,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 +2163,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 +2179,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 +2199,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/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/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/ChangeLog b/gcc/testsuite/ChangeLog index ac63a14..5e19bb9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,132 @@ +2021-06-05 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + 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 <tobias@codesourcery.com> + + PR middle-end/100905 + * gfortran.dg/gomp/loop-3.f90: New test. + +2021-06-04 Iain Buclaw <ibuclaw@gdcproject.org> + + 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 <ppalka@redhat.com> + + 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 <ppalka@redhat.com> + + 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 <anlauf@gmx.de> + + PR fortran/99839 + * gfortran.dg/inline_matmul_25.f90: New test. + +2021-06-04 Martin Sebor <msebor@redhat.com> + + PR c/100783 + * gcc.dg/nonnull-6.c: New test. + +2021-06-04 Martin Sebor <msebor@redhat.com> + + 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 <msebor@redhat.com> + + * gcc.dg/Wvla-parameter-10.c: New test. + * gcc.dg/Wvla-parameter-11.c: New test. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + * 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 <ubizjak@gmail.com> + + PR target/100637 + * gcc.dg/vect/slp-perm-9.c (dg-final): Adjust dumps for vect32 targets. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.dg/gomp/pr99928-5.f90: Really use the + proper iteration variable. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + * 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 <tobias@codesourcery.com> + + PR middle-end/99928 + * gfortran.dg/gomp/loop-2.f90: Update for typo fix. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + 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 <jakub@redhat.com> + + PR target/100887 + * gcc.target/i386/pr100887.c: New test. + +2021-06-04 Jakub Jelinek <jakub@redhat.com> + + PR c++/100872 + * g++.dg/gomp/declare-simd-8.C: New test. + +2021-06-04 Haochen Gui <guihaoc@gcc.gnu.org> + + * gcc.target/powerpc/not-promote-mode.c: New. + 2021-06-03 Uroš Bizjak <ubizjak@gmail.com> PR target/100637 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<int()> struct ratio; +template<class T, class U> struct duration { + static constexpr int _S_gcd(); + template<class> using __is_harmonic = ratio<_S_gcd>; + using type = __is_harmonic<int>; +}; 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<int> struct ratio; +template<class T> struct duration { + static constexpr int _S_gcd(); + template<class> using __is_harmonic = ratio<(duration::_S_gcd)()>; + using type = __is_harmonic<int>; +}; 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(auto) V> decltype(V)& f(); +using type = decltype(f<x>()); +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<Z, const int>); +static_assert(deduced_as<Z, int>); 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/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 <int N, typename T> +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); +} 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<class T, typename T::type F> void g() { } + +struct A { typedef void (*const type)(); }; +void f(); +template void g<A, &f>(); + +struct B { typedef void (B::*const type)(); void f(); }; +template void g<B, &B::f>(); 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<class T, T V> decltype(V)& f(); +using type = decltype(f<const volatile int, 0>()); +using type = int&; 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 } + 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" } 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 <george.thopas@gmail.com> */ + +/* { dg-do compile } */ + +#include <stddef.h> +#include <stdlib.h> + +#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; +} 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/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 } } } } } */ 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); +} 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); +} 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 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 c6206e7..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 339438a..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 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..0cb8661 --- /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 THREAD 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/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/testsuite/gfortran.dg/gomp/pr99928-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 new file mode 100644 index 0000000..e5be42f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-1.f90 @@ -0,0 +1,239 @@ +! PR middle-end/99928 +! { dg-do compile } +! { 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 + +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..22a40e2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-11.f90 @@ -0,0 +1,35 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + implicit none + 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..fe8a715 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-2.f90 @@ -0,0 +1,233 @@ +! PR middle-end/99928 +! { dg-do compile } +! { 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. + !$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..ead8f03 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-4.f90 @@ -0,0 +1,90 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + implicit none + 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..49cbf1e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-5.f90 @@ -0,0 +1,108 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + implicit none + 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" } } + !$omp taskloop simd linear (j10) 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 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..0e60199 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-6.f90 @@ -0,0 +1,108 @@ +! PR middle-end/99928 +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m + implicit none + 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..a5b028b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr99928-8.f90 @@ -0,0 +1,253 @@ +! PR middle-end/99928 +! { dg-do compile } +! { 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 + +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 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 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; 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); |