From f760c0c77fe350616da9dbeaea16442b0acfb09c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 3 Jan 2020 12:56:46 +0000 Subject: =?UTF-8?q?Fortran]=20OpenMP/OpenACC=20=E2=80=93=20fix=20more=20is?= =?UTF-8?q?sues=20with=20OPTIONAL?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit gcc/fortran/ * trans-openmp.c (gfc_omp_check_optional_argument): Always return a Boolean expression; handle unallocated/disassociated actual arguments as absent if passed to nonallocatable/nonpointer dummy array arguments. (gfc_build_cond_assign): Change to assume a Boolean expr not a pointer. (gfc_omp_finish_clause, gfc_trans_omp_clauses): Assign NULL to generated array-data variable if the argument is absent. Simplify code as 'present' is now a Boolean expression. libgomp/ * testsuite/libgomp.fortran/optional-map.f90: Add test for unallocated/disassociated actual arguments to nonallocatable/nonpointer dummy arguments; those are/shall be regarded as absent arguments. * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Ditto. * testsuite/libgomp.fortran/use_device_ptr-optional-3.f90: New. From-SVN: r279858 --- gcc/fortran/trans-openmp.c | 117 ++++++++++++++++++++++++++++++--------------- 1 file changed, 78 insertions(+), 39 deletions(-) (limited to 'gcc/fortran/trans-openmp.c') diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 553d4cb..918af74 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -90,11 +90,16 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check) if (!DECL_LANG_SPECIFIC (decl)) return NULL_TREE; + bool is_array_type = false; + /* For assumed-shape arrays, a local decl with arg->data is used. */ if (TREE_CODE (decl) != PARM_DECL && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)) || GFC_ARRAY_TYPE_P (TREE_TYPE (decl)))) - decl = GFC_DECL_SAVED_DESCRIPTOR (decl); + { + is_array_type = true; + decl = GFC_DECL_SAVED_DESCRIPTOR (decl); + } if (TREE_CODE (decl) != PARM_DECL || !DECL_LANG_SPECIFIC (decl) @@ -126,7 +131,23 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check) return decl; } - return decl; + tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + decl, null_pointer_node); + + /* Fortran regards unallocated allocatables/disassociated pointer which + are passed to a nonallocatable, nonpointer argument as not associated; + cf. F2018, 15.5.2.12, Paragraph 1. */ + if (is_array_type) + { + tree cond2 = build_fold_indirect_ref_loc (input_location, decl); + cond2 = gfc_conv_array_data (cond2); + cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2, null_pointer_node); + cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, cond, cond2); + } + + return cond; } @@ -1192,7 +1213,7 @@ gfc_build_cond_assign (stmtblock_t *block, tree val, tree cond_val, tree then_b, tree else_val) { stmtblock_t cond_block; - tree cond, else_b = NULL_TREE; + tree else_b = NULL_TREE; tree val_ty = TREE_TYPE (val); if (else_val) @@ -1201,15 +1222,9 @@ gfc_build_cond_assign (stmtblock_t *block, tree val, tree cond_val, gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val)); else_b = gfc_finish_block (&cond_block); } - cond = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, - cond_val, null_pointer_node); gfc_add_expr_to_block (block, - build3_loc (input_location, - COND_EXPR, - void_type_node, - cond, then_b, - else_b)); + build3_loc (input_location, COND_EXPR, void_type_node, + cond_val, then_b, else_b)); } /* Build a conditional expression in BLOCK, returning a temporary @@ -1260,8 +1275,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) } tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE; - tree present = (gfc_omp_is_optional_argument (decl) - ? gfc_omp_check_optional_argument (decl, true) : NULL_TREE); + tree present = gfc_omp_check_optional_argument (decl, true); if (POINTER_TYPE_P (TREE_TYPE (decl))) { if (!gfc_omp_privatize_by_reference (decl) @@ -1271,6 +1285,23 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) return; tree orig_decl = decl; + + /* For nonallocatable, nonpointer arrays, a temporary variable is + generated, but this one is only defined if the variable is present; + hence, we now set it to NULL to avoid accessing undefined variables. + We cannot use a temporary variable here as otherwise the replacement + of the variables in omp-low.c will not work. */ + if (present && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))) + { + tree tmp = fold_build2_loc (input_location, MODIFY_EXPR, + void_type_node, decl, null_pointer_node); + tree cond = fold_build1_loc (input_location, TRUTH_NOT_EXPR, + boolean_type_node, present); + tmp = build3_loc (input_location, COND_EXPR, void_type_node, + cond, tmp, NULL_TREE); + gimplify_and_add (tmp, pre_p); + } + c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER); OMP_CLAUSE_DECL (c4) = decl; @@ -1378,10 +1409,8 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) boolean_type_node, tem, null_pointer_node); if (present) { - tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - present, null_pointer_node); cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, tem, cond); + boolean_type_node, present, cond); } gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, void_type_node, cond, @@ -2468,9 +2497,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, TREE_ADDRESSABLE (decl) = 1; if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) { - tree present = (gfc_omp_is_optional_argument (decl) - ? gfc_omp_check_optional_argument (decl, true) - : NULL_TREE); + tree present = gfc_omp_check_optional_argument (decl, true); if (n->sym->ts.type == BT_CLASS) { tree type = TREE_TYPE (decl); @@ -2509,6 +2536,30 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, || n->sym->ts.type == BT_DERIVED)) { tree orig_decl = decl; + + /* For nonallocatable, nonpointer arrays, a temporary + variable is generated, but this one is only defined if + the variable is present; hence, we now set it to NULL + to avoid accessing undefined variables. We cannot use + a temporary variable here as otherwise the replacement + of the variables in omp-low.c will not work. */ + if (present && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))) + { + tree tmp = fold_build2_loc (input_location, + MODIFY_EXPR, + void_type_node, decl, + null_pointer_node); + tree cond = fold_build1_loc (input_location, + TRUTH_NOT_EXPR, + boolean_type_node, + present); + gfc_add_expr_to_block (block, + build3_loc (input_location, + COND_EXPR, + void_type_node, + cond, tmp, + NULL_TREE)); + } node4 = build_omp_clause (input_location, OMP_CLAUSE_MAP); OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER); @@ -2588,17 +2639,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, boolean_type_node, tem, null_pointer_node); if (present) - { - tree tmp = fold_build2_loc (input_location, - NE_EXPR, - boolean_type_node, - present, - null_pointer_node); - cond = fold_build2_loc (input_location, - TRUTH_ANDIF_EXPR, - boolean_type_node, - tmp, cond); - } + cond = fold_build2_loc (input_location, + TRUTH_ANDIF_EXPR, + boolean_type_node, + present, cond); gfc_add_expr_to_block (block, build3_loc (input_location, COND_EXPR, @@ -2617,16 +2661,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree var = gfc_create_var (gfc_array_index_type, NULL); - tree cond = fold_build2_loc (input_location, - NE_EXPR, - boolean_type_node, - present, - null_pointer_node); gfc_add_modify (&cond_block, var, size); - cond = build3_loc (input_location, COND_EXPR, - void_type_node, cond, - gfc_finish_block (&cond_block), - NULL_TREE); + tree cond_body = gfc_finish_block (&cond_block); + tree cond = build3_loc (input_location, COND_EXPR, + void_type_node, present, + cond_body, NULL_TREE); gfc_add_expr_to_block (block, cond); OMP_CLAUSE_SIZE (node) = var; } -- cgit v1.1