diff options
Diffstat (limited to 'gcc')
35 files changed, 766 insertions, 85 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index a2fa483b3cd..03be2a8c57e 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,19 @@ +2018-05-17 Martin Jambor <mjambor@suse.cz> + + Backport from mainline + 2018-05-11 Martin Jambor <mjambor@suse.cz> + + PR ipa/85655 + * ipa-cp.c (intersect_with_plats): Check that the lattice contains + single const. + +2018-05-11 Kyrylo Tkachov <kyrylo.tkachov@arm.com> + + PR target/83687 + * config/arm/neon.md (neon_vabd<mode>_2): Use VCVTF mode iterator. + Remove integer-related logic from pattern. + (neon_vabd<mode>_3): Likewise. + 2018-04-25 Martin Liska <mliska@suse.cz> Backport from mainline diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index cdc90b450c7..a65005539b4 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20180425 +20180522 diff --git a/gcc/config/arm/neon.md b/gcc/config/arm/neon.md index eaa7f4f0afc..431adc587c0 100644 --- a/gcc/config/arm/neon.md +++ b/gcc/config/arm/neon.md @@ -6199,28 +6199,22 @@ if (BYTES_BIG_ENDIAN) }) (define_insn "neon_vabd<mode>_2" - [(set (match_operand:VDQ 0 "s_register_operand" "=w") - (abs:VDQ (minus:VDQ (match_operand:VDQ 1 "s_register_operand" "w") - (match_operand:VDQ 2 "s_register_operand" "w"))))] - "TARGET_NEON && (!<Is_float_mode> || flag_unsafe_math_optimizations)" + [(set (match_operand:VCVTF 0 "s_register_operand" "=w") + (abs:VCVTF (minus:VCVTF (match_operand:VCVTF 1 "s_register_operand" "w") + (match_operand:VCVTF 2 "s_register_operand" "w"))))] + "TARGET_NEON && flag_unsafe_math_optimizations" "vabd.<V_s_elem> %<V_reg>0, %<V_reg>1, %<V_reg>2" - [(set (attr "type") - (if_then_else (ne (symbol_ref "<Is_float_mode>") (const_int 0)) - (const_string "neon_fp_abd_s<q>") - (const_string "neon_abd<q>")))] + [(set_attr "type" "neon_fp_abd_s<q>")] ) (define_insn "neon_vabd<mode>_3" - [(set (match_operand:VDQ 0 "s_register_operand" "=w") - (abs:VDQ (unspec:VDQ [(match_operand:VDQ 1 "s_register_operand" "w") - (match_operand:VDQ 2 "s_register_operand" "w")] - UNSPEC_VSUB)))] - "TARGET_NEON && (!<Is_float_mode> || flag_unsafe_math_optimizations)" + [(set (match_operand:VCVTF 0 "s_register_operand" "=w") + (abs:VCVTF (unspec:VCVTF [(match_operand:VCVTF 1 "s_register_operand" "w") + (match_operand:VCVTF 2 "s_register_operand" "w")] + UNSPEC_VSUB)))] + "TARGET_NEON && flag_unsafe_math_optimizations" "vabd.<V_if_elem> %<V_reg>0, %<V_reg>1, %<V_reg>2" - [(set (attr "type") - (if_then_else (ne (symbol_ref "<Is_float_mode>") (const_int 0)) - (const_string "neon_fp_abd_s<q>") - (const_string "neon_abd<q>")))] + [(set_attr "type" "neon_fp_abd_s<q>")] ) ;; Copy from core-to-neon regs, then extend, not vice-versa diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e7c919c9f2f..88c80c97243 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,75 @@ +2018-05-16 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/83149 + Backport from trunk + * trans-decl.c (gfc_finish_var_decl): Test sym->ns->proc_name + before accessing its components. + * trans-types.c (gfc_sym_type): If a character result has null + backend_decl, try the procedure symbol. + +2018-16-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/83898 + Backport from trunk + * trans-stmt.c (trans_associate_var): Do not set cst_array_ctor + for characters. + +2018-05-13 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/68846 + PR fortran/70864 + Backport from trunk + * resolve.c (get_temp_from_expr): The temporary must not have + dummy or intent attributes. + +2018-05-12 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/85542 + Backport from trunk + * expr.c (check_inquiry): Avoid NULL pointer dereference. + +2018-05-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/70870 + Backport from trunk + * data.c (gfc_assign_data_value): Check that a data object does + not also have default initialization. + +2018-05-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/85521 + Backport from trunk + * array.c (gfc_resolve_character_array_constructor): Substrings + with upper bound smaller than lower bound are zero length strings. + +2018-05-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/85687 + Backport from trunk + * check.c (gfc_check_rank): Check that the argument is a data object. + +2018-05-06 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/85507 + Backport from trunk. + * dependency.c (gfc_dep_resolver): Revert looking at coarray dimension + introduced by r259385. + * trans-intrinsic.c (conv_caf_send): Always report a dependency for + same variables in coarray assignments. + +2018-04-28 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/81773 + PR fortran/83606 + Backport from trunk. + * dependency.c (gfc_dep_resolver): Coarray indexes are to be ignored + during dependency computation. They define no data dependency. + * trans-array.c (conv_array_index_offset): The stride can not be set + here, prevent fail. + * trans-intrinsic.c (conv_caf_send): Add creation of temporary array + for caf_get's result and copying to the array with vectorial + indexing. + 2018-04-24 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/85520 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index b87e8555972..29f96d9d6d5 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -2018,7 +2018,8 @@ got_charlen: else return true; - gcc_assert (current_length != -1); + if (current_length < 0) + current_length = 0; if (found_length == -1) found_length = current_length; diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index f7829db7a7d..097f9834880 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3636,8 +3636,11 @@ gfc_check_rank (gfc_expr *a ATTRIBUTE_UNUSED) ? a->value.function.esym->result->attr.pointer : a->symtree->n.sym->result->attr.pointer; - if (a->expr_type == EXPR_OP || a->expr_type == EXPR_NULL - || a->expr_type == EXPR_COMPCALL|| a->expr_type == EXPR_PPC + if (a->expr_type == EXPR_OP + || a->expr_type == EXPR_NULL + || a->expr_type == EXPR_COMPCALL + || a->expr_type == EXPR_PPC + || a->ts.type == BT_PROCEDURE || !is_variable) { gfc_error ("The argument of the RANK intrinsic at %L must be a data " diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 139ce880534..6e580700b77 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -489,6 +489,15 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, } else { + if (lvalue->ts.type == BT_DERIVED + && gfc_has_default_initializer (lvalue->ts.u.derived)) + { + gfc_error ("Nonpointer object %qs with default initialization " + "shall not appear in a DATA statement at %L", + symbol->name, &lvalue->where); + return false; + } + /* Overwriting an existing initializer is non-standard but usually only provokes a warning from other compilers. */ if (init != NULL) diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index aceefb6e110..bc42dea14ec 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2321,7 +2321,7 @@ check_inquiry (gfc_expr *e, int not_restricted) /* Assumed character length will not reduce to a constant expression with LEN, as required by the standard. */ - if (i == 5 && not_restricted + if (i == 5 && not_restricted && ap->expr->symtree && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL || ap->expr->symtree->n.sym->ts.deferred)) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 99ee31efeeb..0285089ef0e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9940,6 +9940,8 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns) tmp->n.sym->attr.function = 0; tmp->n.sym->attr.result = 0; tmp->n.sym->attr.flavor = FL_VARIABLE; + tmp->n.sym->attr.dummy = 0; + tmp->n.sym->attr.intent = INTENT_UNKNOWN; if (as) { diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c9ed95bbd9f..0842a39db1a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3022,7 +3022,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, } /* Multiply by the stride. */ - if (!integer_onep (stride)) + if (stride != NULL && !integer_onep (stride)) index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, index, stride); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 7b30380f50a..66c3f75cca0 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -571,10 +571,12 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) function scope. */ if (current_function_decl != NULL_TREE) { - if (sym->ns->proc_name->backend_decl == current_function_decl - || sym->result == sym) + if (sym->ns->proc_name + && (sym->ns->proc_name->backend_decl == current_function_decl + || sym->result == sym)) gfc_add_decl_to_function (decl); - else if (sym->ns->proc_name->attr.flavor == FL_LABEL) + else if (sym->ns->proc_name + && sym->ns->proc_name->attr.flavor == FL_LABEL) /* This is a BLOCK construct. */ add_decl_as_local (decl); else @@ -646,7 +648,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) } /* Keep variables larger than max-stack-var-size off stack. */ - if (!sym->ns->proc_name->attr.recursive + if (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive && INTEGER_CST_P (DECL_SIZE_UNIT (decl)) && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) /* Put variable length auto array pointers always into stack. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index bad959bda88..a13e72ca2a5 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1249,7 +1249,7 @@ conv_caf_send (gfc_code *code) { lhs_expr = code->ext.actual->expr; rhs_expr = code->ext.actual->next->expr; - may_require_tmp = gfc_check_dependency (lhs_expr, rhs_expr, false) == 0 + may_require_tmp = gfc_check_dependency (lhs_expr, rhs_expr, true) == 0 ? boolean_false_node : boolean_true_node; gfc_init_block (&block); @@ -1266,34 +1266,124 @@ conv_caf_send (gfc_code *code) { } else { - /* If has_vector, pass descriptor for whole array and the - vector bounds separately. */ - gfc_array_ref *ar, ar2; - bool has_vector = false; + bool has_vector = gfc_has_vector_subscript (lhs_expr); - if (gfc_is_coindexed (lhs_expr) && gfc_has_vector_subscript (lhs_expr)) + if (gfc_is_coindexed (lhs_expr) || !has_vector) { - has_vector = true; - ar = gfc_find_array_ref (lhs_expr); - ar2 = *ar; - memset (ar, '\0', sizeof (*ar)); - ar->as = ar2.as; - ar->type = AR_FULL; + /* If has_vector, pass descriptor for whole array and the + vector bounds separately. */ + gfc_array_ref *ar, ar2; + bool has_tmp_lhs_array = false; + if (has_vector) + { + has_tmp_lhs_array = true; + ar = gfc_find_array_ref (lhs_expr); + ar2 = *ar; + memset (ar, '\0', sizeof (*ar)); + ar->as = ar2.as; + ar->type = AR_FULL; + } + lhs_se.want_pointer = 1; + gfc_conv_expr_descriptor (&lhs_se, lhs_expr); + /* Using gfc_conv_expr_descriptor, we only get the descriptor, but + that has the wrong type if component references are done. */ + lhs_type = gfc_typenode_for_spec (&lhs_expr->ts); + tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr); + gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp), + gfc_get_dtype_rank_type (has_vector ? ar2.dimen + : lhs_expr->rank, + lhs_type)); + if (has_tmp_lhs_array) + { + vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2); + *ar = ar2; + } } - lhs_se.want_pointer = 1; - gfc_conv_expr_descriptor (&lhs_se, lhs_expr); - /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that - has the wrong type if component references are done. */ - lhs_type = gfc_typenode_for_spec (&lhs_expr->ts); - tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr); - gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp), - gfc_get_dtype_rank_type (has_vector ? ar2.dimen - : lhs_expr->rank, - lhs_type)); - if (has_vector) + else { - vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2); - *ar = ar2; + /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to + indexed array expression. This is rewritten to: + + tmp_array = arr2[...] + arr1 ([...]) = tmp_array + + because using the standard gfc_conv_expr (lhs_expr) did the + assignment with lhs and rhs exchanged. */ + + gfc_ss *lss_for_tmparray, *lss_real; + gfc_loopinfo loop; + gfc_se se; + stmtblock_t body; + tree tmparr_desc, src; + tree index = gfc_index_zero_node; + tree stride = gfc_index_zero_node; + int n; + + /* Walk both sides of the assignment, once to get the shape of the + temporary array to create right. */ + lss_for_tmparray = gfc_walk_expr (lhs_expr); + /* And a second time to be able to create an assignment of the + temporary to the lhs_expr. gfc_trans_create_temp_array replaces + the tree in the descriptor with the one for the temporary + array. */ + lss_real = gfc_walk_expr (lhs_expr); + gfc_init_loopinfo (&loop); + gfc_add_ss_to_loop (&loop, lss_for_tmparray); + gfc_add_ss_to_loop (&loop, lss_real); + gfc_conv_ss_startstride (&loop); + gfc_conv_loop_setup (&loop, &lhs_expr->where); + lhs_type = gfc_typenode_for_spec (&lhs_expr->ts); + gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post, + lss_for_tmparray, lhs_type, NULL_TREE, + false, true, false, + &lhs_expr->where); + tmparr_desc = lss_for_tmparray->info->data.array.descriptor; + gfc_start_scalarized_body (&loop, &body); + gfc_init_se (&se, NULL); + gfc_copy_loopinfo_to_se (&se, &loop); + se.ss = lss_real; + gfc_conv_expr (&se, lhs_expr); + gfc_add_block_to_block (&body, &se.pre); + + /* Walk over all indexes of the loop. */ + for (n = loop.dimen - 1; n > 0; --n) + { + tmp = loop.loopvar[n]; + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, tmp, loop.from[n]); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, index); + + stride = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + loop.to[n - 1], loop.from[n - 1]); + stride = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + stride, gfc_index_one_node); + + index = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, tmp, stride); + } + + index = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + index, loop.from[0]); + + index = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + loop.loopvar[0], index); + + src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc)); + src = gfc_build_array_ref (src, index, NULL); + /* Now create the assignment of lhs_expr = tmp_array. */ + gfc_add_modify (&body, se.expr, src); + gfc_add_block_to_block (&body, &se.post); + lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc); + gfc_trans_scalarizing_loops (&loop, &body); + gfc_add_block_to_block (&loop.pre, &loop.post); + gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre)); + gfc_free_ss (lss_for_tmparray); + gfc_free_ss (lss_real); } } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 45510bc51f7..58add0b5d9b 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1541,7 +1541,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) desc = sym->backend_decl; cst_array_ctor = e->expr_type == EXPR_ARRAY - && gfc_constant_array_constructor_p (e->value.constructor); + && gfc_constant_array_constructor_p (e->value.constructor) + && e->ts.type != BT_CHARACTER; /* If association is to an expression, evaluate it and create temporary. Otherwise, get descriptor of target for pointer assignment. */ diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 98013c95be8..87180ad8011 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2167,6 +2167,14 @@ gfc_sym_type (gfc_symbol * sym) if (sym->backend_decl && !sym->attr.function) return TREE_TYPE (sym->backend_decl); + if (sym->attr.result + && sym->ts.type == BT_CHARACTER + && sym->ts.u.cl->backend_decl == NULL_TREE + && sym->ns->proc_name + && sym->ns->proc_name->ts.u.cl + && sym->ns->proc_name->ts.u.cl->backend_decl != NULL_TREE) + sym->ts.u.cl->backend_decl = sym->ns->proc_name->ts.u.cl->backend_decl; + if (sym->ts.type == BT_CHARACTER && ((sym->attr.function && sym->attr.is_bind_c) || (sym->attr.result diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c index caa346f7016..b09167fc99f 100644 --- a/gcc/ipa-cp.c +++ b/gcc/ipa-cp.c @@ -3703,7 +3703,9 @@ intersect_with_plats (struct ipcp_param_lattices *plats, if (aglat->offset - offset == item->offset) { gcc_checking_assert (item->value); - if (values_equal_for_ipcp_p (item->value, aglat->values->value)) + if (aglat->is_single_const () + && values_equal_for_ipcp_p (item->value, + aglat->values->value)) found = true; break; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 190eccbbbf6..3bf4e5c6727 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,81 @@ +2017-05-17 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/82814 + Backport from trunk + * gfortran.dg/submodule_31.f08: New test. + +2018-05-16 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/83149 + Backport from trunk + * gfortran.dg/pr83149_1.f90: New test. + * gfortran.dg/pr83149.f90: Additional source for previous. + * gfortran.dg/pr83149_b.f90: New test. + * gfortran.dg/pr83149_a.f90: Additional source for previous. + +2018-16-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/83898 + Backport from trunk + * gfortran.dg/associate_33.f03 : New test. + +2018-05-13 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/68846 + Backport from trunk + * gfortran.dg/temporary_3.f90 : New test. + + PR fortran/70864 + Backport from trunk + * gfortran.dg/temporary_2.f90 : New test. + +2018-05-12 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/85542 + Backport from trunk + * gfortran.dg/pr85542.f90: New test. + +2018-05-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/70870 + Backport from trunk + * gfortran.dg/pr70870_1.f90: New test. + +2018-05-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/85521 + Backport from trunk + * gfortran.dg/pr85521_1.f90: New test. + * gfortran.dg/pr85521_2.f90: New test. + +2018-05-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/85687 + Backport from trunk + * gfortran.dg/pr85687.f90: new test. + +2018-05-11 Kyrylo Tkachov <kyrylo.tkachov@arm.com> + + PR target/83687 + * gcc.target/arm/neon-combine-sub-abs-into-vabd.c: Delete integer + tests. + * gcc.target/arm/pr83687.c: New test. + +2018-05-06 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/85507 + Backport from trunk. + * gfortran.dg/coarray_dependency_1.f90: New test. + * gfortran.dg/coarray_lib_comm_1.f90: Fix counting caf-expressions. + +2018-04-28 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/81773 + PR fortran/83606 + Backport from trunk. + * gfortran.dg/coarray/get_to_indexed_array_1.f90: New test. + * gfortran.dg/coarray/get_to_indirect_array.f90: New test. + 2018-04-25 Martin Liska <mliska@suse.cz> Backport from mainline diff --git a/gcc/testsuite/gcc.target/arm/neon-combine-sub-abs-into-vabd.c b/gcc/testsuite/gcc.target/arm/neon-combine-sub-abs-into-vabd.c index fe3d78b308c..784714f0e87 100644 --- a/gcc/testsuite/gcc.target/arm/neon-combine-sub-abs-into-vabd.c +++ b/gcc/testsuite/gcc.target/arm/neon-combine-sub-abs-into-vabd.c @@ -12,31 +12,3 @@ float32x2_t f_sub_abs_to_vabd_32(float32x2_t val1, float32x2_t val2) return res; } /* { dg-final { scan-assembler "vabd\.f32" } }*/ - -#include <arm_neon.h> -int8x8_t sub_abs_to_vabd_8(int8x8_t val1, int8x8_t val2) -{ - int8x8_t sres = vsub_s8(val1, val2); - int8x8_t res = vabs_s8 (sres); - - return res; -} -/* { dg-final { scan-assembler "vabd\.s8" } }*/ - -int16x4_t sub_abs_to_vabd_16(int16x4_t val1, int16x4_t val2) -{ - int16x4_t sres = vsub_s16(val1, val2); - int16x4_t res = vabs_s16 (sres); - - return res; -} -/* { dg-final { scan-assembler "vabd\.s16" } }*/ - -int32x2_t sub_abs_to_vabd_32(int32x2_t val1, int32x2_t val2) -{ - int32x2_t sres = vsub_s32(val1, val2); - int32x2_t res = vabs_s32 (sres); - - return res; -} -/* { dg-final { scan-assembler "vabd\.s32" } }*/ diff --git a/gcc/testsuite/gcc.target/arm/pr83687.c b/gcc/testsuite/gcc.target/arm/pr83687.c new file mode 100644 index 00000000000..42754138660 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/pr83687.c @@ -0,0 +1,31 @@ +/* { dg-do run } */ +/* { dg-require-effective-target arm_neon_hw } */ +/* { dg-options "-O2" } */ +/* { dg-add-options arm_neon } */ + +#include <arm_neon.h> + +__attribute__ ((noinline)) int8_t +testFunction1 (int8_t a, int8_t b) +{ + volatile int8x16_t sub = vsubq_s8 (vdupq_n_s8 (a), vdupq_n_s8 (b)); + int8x16_t abs = vabsq_s8 (sub); + return vgetq_lane_s8 (abs, 0); +} + +__attribute__ ((noinline)) int8_t +testFunction2 (int8_t a, int8_t b) +{ + int8x16_t sub = vsubq_s8 (vdupq_n_s8 (a), vdupq_n_s8 (b)); + int8x16_t abs = vabsq_s8 (sub); + return vgetq_lane_s8 (abs, 0); +} + +int +main (void) +{ + if (testFunction1 (-100, 100) != testFunction2 (-100, 100)) + __builtin_abort (); + + return 0; +} diff --git a/gcc/testsuite/gfortran.dg/associate_33.f03 b/gcc/testsuite/gfortran.dg/associate_33.f03 new file mode 100644 index 00000000000..1f87b22e8e4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_33.f03 @@ -0,0 +1,11 @@ +! { dg-do run } +! +! Test the fix for PR83898.f90 +! +! Contributed by G Steinmetz <gscfq@t-online.de> +! +program p + associate (x => ['1','2']) + if (any (x .ne. ['1','2'])) call abort + end associate +end diff --git a/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 new file mode 100644 index 00000000000..04714711707 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 @@ -0,0 +1,32 @@ +! { dg-do run } + +! Test that index vector on lhs of caf-expression works correctly. + +program pr81773 + + integer, parameter :: ndim = 5 + integer :: i + integer :: vec(ndim) = -1 + integer :: res(ndim)[*] = [ (i, i=1, ndim) ] + type T + integer :: padding + integer :: dest(ndim) + integer :: src(ndim) + end type + + type(T) :: dest + type(T), allocatable :: caf[:] + + vec([ndim, 3, 1]) = res(1:3)[1] + if (any (vec /= [ 3, -1, 2, -1, 1])) stop 1 + + dest = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] ) + dest%dest([ 4,3,2 ]) = res(3:5)[1] + if (any (dest%dest /= [-1, 5, 4, 3, -1])) stop 2 + + vec(:) = -1 + allocate(caf[*], source = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] )) + vec([ 5,3,2 ]) = caf[1]%src(2:4) + if (any (vec /= [ -1, 0, 1, -1, 2])) stop 3 +end + diff --git a/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 b/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 new file mode 100644 index 00000000000..efb78353637 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! +! Test that pr81773/fortran is fixed. + +program get_to_indexed_array + + integer, parameter :: ndim = 5 + integer :: i + integer :: vec(1:ndim) = 0 + integer :: indx(1:2) = [3, 2] + integer :: mat(1:ndim, 1:ndim) = 0 + integer :: res(1:ndim)[*]=[ (i, i=1, ndim) ] + + ! No sync needed, because this test always is running on single image + vec([ndim , 1]) = res(1:2)[1] + if (vec(1) /= res(2) .or. vec(ndim) /= res(1)) then + print *,"vec: ", vec, " on image: ", this_image() + stop 1 + end if + + mat(2:3,[indx(:)]) = reshape(res(1:4)[1], [2, 2]) + if (any(mat(2:3, 3:2:-1) /= reshape(res(1:4), [2,2]))) then + print *, "mat: ", mat, " on image: ", this_image() + stop 2 + end if +end + +! vim:ts=2:sts=2:sw=2: diff --git a/gcc/testsuite/gfortran.dg/coarray_dependency_1.f90 b/gcc/testsuite/gfortran.dg/coarray_dependency_1.f90 new file mode 100644 index 00000000000..dc4cbacba1e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_dependency_1.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -lcaf_single" } +! +! Check that reffing x on both sides of a coarray send does not ICE. +! PR 85507 + +program check_dependency + integer :: x[*] + x[42] = x +end program check_dependency + diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 index d23c9d18a7a..d5051254312 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 @@ -38,9 +38,8 @@ B(1:5) = B(3:7) if (any (A-B /= 0)) call abort end -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1\\\);" 2 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1\\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 1\\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pr70870_1.f90 b/gcc/testsuite/gfortran.dg/pr70870_1.f90 new file mode 100644 index 00000000000..0f9584a36db --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr70870_1.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! PR fortran/70870 +! Contributed by Vittorio Zecca <zeccav at gmail dot com > + type t + integer :: g=0 ! default initialization + end type + type(t) :: v2 + data v2/t(2)/ ! { dg-error "default initialization shall not" } + end diff --git a/gcc/testsuite/gfortran.dg/pr83149.f90 b/gcc/testsuite/gfortran.dg/pr83149.f90 new file mode 100644 index 00000000000..fc0607e1369 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr83149.f90 @@ -0,0 +1,14 @@ +! Compiled with pr83149_1.f90 +! +module mod1 + integer :: ncells +end module + +module mod2 +contains + function get() result(array) + use mod1 + real array(ncells) + array = 1.0 + end function +end module diff --git a/gcc/testsuite/gfortran.dg/pr83149_1.f90 b/gcc/testsuite/gfortran.dg/pr83149_1.f90 new file mode 100644 index 00000000000..3a8f5d55d9b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr83149_1.f90 @@ -0,0 +1,24 @@ +! Compiled with pr83149.f90 +! { dg-do run } +! { dg-options "-fno-whole-file" } +! { dg-compile-aux-modules "pr83149.f90" } +! { dg-additional-sources pr83149.f90 } +! +! Contributed by Neil Carlson <neil.n.carlson@gmail.com> +! +subroutine sub(s) + use mod2 + real :: s + s = sum(get()) +end + + use mod1 + real :: s + ncells = 2 + call sub (s) + if (int (s) .ne. ncells) stop 1 + ncells = 10 + call sub (s) + if (int (s) .ne. ncells) stop 2 +end + diff --git a/gcc/testsuite/gfortran.dg/pr83149_a.f90 b/gcc/testsuite/gfortran.dg/pr83149_a.f90 new file mode 100644 index 00000000000..3f15198bfe9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr83149_a.f90 @@ -0,0 +1,11 @@ +! Compiled with pr83149_b.f90 +! +module mod + character(8) string +contains + function get_string() result(s) + character(len_trim(string)) s + s = string + end function +end module + diff --git a/gcc/testsuite/gfortran.dg/pr83149_b.f90 b/gcc/testsuite/gfortran.dg/pr83149_b.f90 new file mode 100644 index 00000000000..f67ffd95159 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr83149_b.f90 @@ -0,0 +1,16 @@ +! Compiled with pr83149_a.f90 +! { dg-do run } +! { dg-options "-fno-whole-file" } +! { dg-compile-aux-modules "pr83149_a.f90" } +! { dg-additional-sources pr83149_a.f90 } +! +! Contributed by Neil Carlson <neil.n.carlson@gmail.com> +! + use mod + string = 'fubar' + select case (get_string()) + case ('fubar') + case default + stop 1 + end select +end diff --git a/gcc/testsuite/gfortran.dg/pr85521_1.f90 b/gcc/testsuite/gfortran.dg/pr85521_1.f90 new file mode 100644 index 00000000000..57e4620fe0d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr85521_1.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! PR fortran/85521 +program p + character(3) :: c = 'abc' + character(3) :: z(1) + z = [ c(:-1) ] + print *, z +end diff --git a/gcc/testsuite/gfortran.dg/pr85521_2.f90 b/gcc/testsuite/gfortran.dg/pr85521_2.f90 new file mode 100644 index 00000000000..737b61a11b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr85521_2.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! PR fortran/85521 +program p + character(3) :: c = 'abc' + character(3) :: z(1) + z = [ c(:-2) ] + print *, z +end diff --git a/gcc/testsuite/gfortran.dg/pr85542.f90 b/gcc/testsuite/gfortran.dg/pr85542.f90 new file mode 100644 index 00000000000..f61d2c9beb0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr85542.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } +! PR fortran/85542 +function f(x) + character(*), intent(in) :: x + character((len((x)))) :: f + f = x +end diff --git a/gcc/testsuite/gfortran.dg/pr85687.f90 b/gcc/testsuite/gfortran.dg/pr85687.f90 new file mode 100644 index 00000000000..03bc2119364 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr85687.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! PR fortran/85687 +! Code original contributed by Gerhard Steinmetz gscfq at t-oline dot de +program p + type t + end type + print *, rank(t) ! { dg-error "must be a data object" } +end diff --git a/gcc/testsuite/gfortran.dg/submodule_31.f08 b/gcc/testsuite/gfortran.dg/submodule_31.f08 new file mode 100644 index 00000000000..72594d05df3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_31.f08 @@ -0,0 +1,54 @@ +! { dg-do run } +! +! Test the fix for PR82814 in which an ICE occurred for the submodule allocation. +! +! Contributed by "Werner Blokbuster" <werner.blokbuster@gmail.com> +! +module u + + implicit none + + interface unique + module function uniq_char(input) result(uniq) + character(*), intent(in) :: input(:) + character(size(input)), allocatable :: uniq(:) + end function uniq_char + end interface unique + +contains + + module function uniq2(input) result(uniq) + character(*), intent(in) :: input(:) + character(size(input)), allocatable :: uniq(:) + allocate(uniq(1)) + uniq = 'A' + end function uniq2 + +end module u + + +submodule (u) z + + implicit none + +contains + + module function uniq_char(input) result(uniq) + character(*), intent(in) :: input(:) + character(size(input)), allocatable :: uniq(:) + allocate(uniq(1)) ! This used to ICE + uniq = 'A' + end function uniq_char + +end submodule z + + +program test_uniq + use u + implicit none + character(1), dimension(4) :: chr = ['1','2','1','2'] + + write(*,*) unique(chr) + write(*,*) uniq2(chr) + +end program test_uniq diff --git a/gcc/testsuite/gfortran.dg/temporary_2.f90 b/gcc/testsuite/gfortran.dg/temporary_2.f90 new file mode 100644 index 00000000000..0598ea54f28 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/temporary_2.f90 @@ -0,0 +1,39 @@ +! { dg-do compile } +! +! Tests the fix for PR70864 in which compiler generated temporaries received +! the attributes of a dummy argument. This is the original testcase. +! The simplified version by Gerhard Steinmetz is gratefully acknowledged. +! +! Contributed by Weiqun Zhang <weiqun.zhang@gmail.com> +! +module boxarray_module + implicit none + type :: BoxArray + integer :: i = 0 + contains + procedure :: boxarray_assign + generic :: assignment(=) => boxarray_assign + end type BoxArray +contains + subroutine boxarray_assign (dst, src) + class(BoxArray), intent(inout) :: dst + type (BoxArray), intent(in ) :: src + dst%i =src%i + end subroutine boxarray_assign +end module boxarray_module + +module multifab_module + use boxarray_module + implicit none + type, public :: MultiFab + type(BoxArray) :: ba + end type MultiFab +contains + subroutine multifab_swap(mf1, mf2) + type(MultiFab), intent(inout) :: mf1, mf2 + type(MultiFab) :: tmp + tmp = mf1 + mf1 = mf2 ! Generated an ICE in trans-decl.c. + mf2 = tmp + end subroutine multifab_swap +end module multifab_module diff --git a/gcc/testsuite/gfortran.dg/temporary_3.f90 b/gcc/testsuite/gfortran.dg/temporary_3.f90 new file mode 100644 index 00000000000..84b300a38d9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/temporary_3.f90 @@ -0,0 +1,121 @@ +! { dg-do run } +! +! Tests the fix for PR68846 in which compiler generated temporaries were +! receiving the attributes of dummy arguments. This test is the original. +! The simplified versions by Gerhard Steinmetz are gratefully acknowledged. +! +! Contributed by Mirco Valentini <mirco.valentini@polimi.it> +! +MODULE grid + IMPLICIT NONE + PRIVATE + REAL(KIND=8), DIMENSION(100,100), TARGET :: WORKSPACE + TYPE, PUBLIC :: grid_t + REAL(KIND=8), DIMENSION(:,:), POINTER :: P => NULL () + END TYPE + PUBLIC :: INIT +CONTAINS + SUBROUTINE INIT (DAT) + IMPLICIT NONE + TYPE(grid_t), INTENT(INOUT) :: DAT + INTEGER :: I, J + DAT%P => WORKSPACE + DO I = 1, 100 + DO J = 1, 100 + DAT%P(I,J) = REAL ((I-1)*100+J-1) + END DO + ENDDO + END SUBROUTINE INIT +END MODULE grid + +MODULE subgrid + USE :: grid, ONLY: grid_t + IMPLICIT NONE + PRIVATE + TYPE, PUBLIC :: subgrid_t + INTEGER, DIMENSION(4) :: range + CLASS(grid_t), POINTER :: grd => NULL () + CONTAINS + PROCEDURE, PASS :: INIT => LVALUE_INIT + PROCEDURE, PASS :: JMP => LVALUE_JMP + END TYPE +CONTAINS + SUBROUTINE LVALUE_INIT (HOBJ, P, D) + IMPLICIT NONE + CLASS(subgrid_t), INTENT(INOUT) :: HOBJ + TYPE(grid_t), POINTER, INTENT(INOUT) :: P + INTEGER, DIMENSION(4), INTENT(IN) :: D + HOBJ%range = D + HOBJ%grd => P + END SUBROUTINE LVALUE_INIT + + FUNCTION LVALUE_JMP(HOBJ, I, J) RESULT(P) + IMPLICIT NONE + CLASS(subgrid_t), INTENT(INOUT) :: HOBJ + INTEGER, INTENT(IN) :: I, J + REAL(KIND=8), POINTER :: P + P => HOBJ%grd%P(HOBJ%range(1)+I-1, HOBJ%range(3)+J-1) + END FUNCTION LVALUE_JMP +END MODULE subgrid + +MODULE geom + IMPLICIT NONE +CONTAINS + SUBROUTINE fillgeom_03( subgrid, value ) + USE :: subgrid, ONLY: subgrid_t + IMPLICIT NONE + TYPE(subgrid_T), intent(inout) :: subgrid + REAL(kind=8), intent(in) :: value + INTEGER :: I, J + DO i = 1, 3 + DO J = 1, 4 + subgrid%jmp(i,j) = value ! Dummy argument '_F.DA0' with INTENT(IN) + ! in pointer association context or ICE + ! in trans_decl.c, depending on INTENT of + ! 'VALUE' + ENDDO + ENDDO + END SUBROUTINE fillgeom_03 +END MODULE geom + +PROGRAM test_lvalue + USE :: grid + USE :: subgrid + USE :: geom + IMPLICIT NONE + TYPE(grid_t), POINTER :: GRD => NULL() + TYPE(subgrid_t) :: STENCIL + REAL(KIND=8), POINTER :: real_tmp_ptr + REAL(KIND=8), DIMENSION(10,10), TARGET :: AA + REAL(KIND=8), DIMENSION(3,4) :: VAL + INTEGER :: I, J, chksum + integer, parameter :: r1 = 50 + integer, parameter :: r2 = 52 + integer, parameter :: r3 = 50 + integer, parameter :: r4 = 53 + DO I = 1, 3 + DO J = 1, 4 + VAL(I,J) = dble(I)*dble(J) + ENDDO + ENDDO + + ALLOCATE (GRD) + CALL INIT (GRD) + chksum = sum([([((i-1)*100 + j -1, j=1,100)], i = 1,100)]) + if (int(sum(grd%p)) .ne. chksum) stop 1 + + CALL STENCIL%INIT (GRD, [r1, r2, r3, r4]) + if (.not.associated (stencil%grd, grd)) stop 2 + if (int(sum(grd%p)) .ne. chksum) stop 3 + + CALL fillgeom_03(stencil, 42.0_8) + if (any (int (grd%p(r1:r2,r3:r4)) .ne. 42)) stop 4 + + chksum = chksum - sum([([((i - 1) * 100 + j -1, j=r3,r4)], i = r1,r2)]) & + + (r4 - r3 + 1) * (r2 - r1 +1) * 42 + if (int(sum(grd%p)) .ne. chksum) stop 5 + + deallocate (grd) +END PROGRAM test_lvalue + + |