+2020-05-11 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/94672
+ * trans.h (gfc_conv_expr_present): Add use_saved_decl=false argument.
+ * trans-expr.c (gfc_conv_expr_present): Likewise; use DECL directly
+ and only if use_saved_decl is true, use the actual PARAM_DECL arg (saved
+ descriptor).
+ * trans-array.c (gfc_trans_dummy_array_bias): Set local 'arg.0'
+ variable to NULL if 'arg' is not present.
+ * trans-openmp.c (gfc_omp_check_optional_argument): Simplify by checking
+ 'arg.0' instead of the true PARM_DECL.
+ (gfc_omp_finish_clause): Remove setting 'arg.0' to NULL.
+
2020-05-11 Janus Weil <janus@gcc.gnu.org>
Dominique d'Humieres <dominiq@lps.ens.fr>
-
+
PR fortran/59107
* gfortran.h: Rename field resolved as resolve_symbol_called
and assign two 2 bits instead of 1.
&& sym->attr.dummy));
if (optional_arg)
{
- tmp = gfc_conv_expr_present (sym);
- stmtInit = build3_v (COND_EXPR, tmp, stmtInit,
- build_empty_stmt (input_location));
+ tree zero_init = fold_convert (TREE_TYPE (tmpdesc), null_pointer_node);
+ zero_init = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+ tmpdesc, zero_init);
+ tmp = gfc_conv_expr_present (sym, true);
+ stmtInit = build3_v (COND_EXPR, tmp, stmtInit, zero_init);
}
/* Cleanup code. */
Also used for arguments to procedures with multiple entry points. */
tree
-gfc_conv_expr_present (gfc_symbol * sym)
+gfc_conv_expr_present (gfc_symbol * sym, bool use_saved_desc)
{
- tree decl, cond;
+ tree decl, orig_decl, cond;
gcc_assert (sym->attr.dummy);
- decl = gfc_get_symbol_decl (sym);
+ orig_decl = decl = gfc_get_symbol_decl (sym);
/* Intrinsic scalars with VALUE attribute which are passed by value
use a hidden argument to denote the present status. */
return cond;
}
- if (TREE_CODE (decl) != PARM_DECL)
+ /* Assumed-shape arrays use a local variable for the array data;
+ the actual PARAM_DECL is in a saved decl. As the local variable
+ is NULL, it can be checked instead, unless use_saved_desc is
+ requested. */
+
+ if (use_saved_desc && TREE_CODE (decl) != PARM_DECL)
{
- /* Array parameters use a temporary descriptor, we want the real
- parameter. */
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
|| GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
we thus also need to check the array descriptor. For BT_CLASS, it
can also occur for scalars and F2003 due to type->class wrapping and
class->class wrapping. Note further that BT_CLASS always uses an
- array descriptor for arrays, also for explicit-shape/assumed-size. */
+ array descriptor for arrays, also for explicit-shape/assumed-size.
+ For assumed-rank arrays, no local variable is generated, hence,
+ the following also applies with !use_saved_desc. */
- if (!sym->attr.allocatable
+ if ((use_saved_desc || TREE_CODE (orig_decl) == PARM_DECL)
+ && !sym->attr.allocatable
&& ((sym->ts.type != BT_CLASS && !sym->attr.pointer)
|| (sym->ts.type == BT_CLASS
&& !CLASS_DATA (sym)->attr.allocatable
if (!DECL_LANG_SPECIFIC (decl))
return NULL_TREE;
- bool is_array_type = false;
+ tree orig_decl = decl;
/* 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))))
- {
- is_array_type = true;
- decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
- }
+ decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
if (decl == NULL_TREE
|| TREE_CODE (decl) != PARM_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;
+ return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+ orig_decl, null_pointer_node);
}
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;
void gfc_conv_structure (gfc_se *, gfc_expr *, int);
/* Return an expression which determines if a dummy parameter is present. */
-tree gfc_conv_expr_present (gfc_symbol *);
+tree gfc_conv_expr_present (gfc_symbol *, bool use_saved_decl = false);
/* Convert a missing, dummy argument into a null or zero. */
void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int);
+2020-05-11 Jakub Jelinek <jakub@redhat.com>
+ Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/94672
+ * gfortran.dg/gomp/pr94672.f90: New.
+ * gfortran.dg/missing_optional_dummy_6a.f90: Update scan-tree.
+
2020-05-11 Felix Yang <felix.yang@huawei.com>
PR target/94991
--- /dev/null
+! { dg-do compile }
+
+SUBROUTINE foo(n,array)
+ IMPLICIT NONE
+ INTEGER, INTENT (IN) :: n
+ REAL, INTENT(INOUT),OPTIONAL:: array(:)
+ INTEGER:: i
+
+ !$OMP PARALLEL DO DEFAULT(none) SHARED(array,n) PRIVATE(i)
+ DO i = 1,n
+ IF (PRESENT(array)) THEN
+ array(i) = array(i) + i
+ ENDIF
+ ENDDO
+ !$OMP END PARALLEL DO
+END SUBROUTINE foo
+
+subroutine s1 (array)
+ real, optional :: array(:)
+ !$omp parallel default(none) firstprivate (array)
+ if (present (array)) array(:) = 3
+ !$omp end parallel
+end subroutine
+
+subroutine s2 (array)
+ real, optional :: array(:)
+ !$omp parallel default(none) shared (array)
+ !$omp master
+ if (present (array)) array(:) = 3
+ !$omp end master
+ !$omp end parallel
+end subroutine
+
+subroutine s3 (array)
+ real, optional :: array(:)
+ !$omp parallel default(none) private (array)
+ if (present (array)) array(:) = 3
+ !$omp end parallel
+end subroutine
+
+subroutine s4 (arg)
+ real, optional :: arg
+ !$omp parallel default(none) firstprivate (arg)
+ if (present (arg)) arg = 3
+ !$omp end parallel
+end subroutine
+
+subroutine s5 (arg)
+ real, optional :: arg
+ !$omp parallel default(none) shared (arg)
+ !$omp master
+ if (present (arg)) arg = 3
+ !$omp end master
+ !$omp end parallel
+end subroutine
+
+subroutine s6 (arg)
+ real, optional :: arg
+ !$omp parallel default(none) private (arg)
+ if (present (arg)) arg = 3
+ !$omp end parallel
+end subroutine
+
+subroutine s7 (arg)
+ real, value, optional :: arg
+ !$omp parallel default(none) firstprivate (arg)
+ if (present (arg)) arg = 3
+ !$omp end parallel
+end subroutine
+
+subroutine s8 (arg)
+ real, value, optional :: arg
+ !$omp parallel default(none) shared (arg)
+ !$omp master
+ if (present (arg)) arg = 3
+ !$omp end master
+ !$omp end parallel
+end subroutine
+
+subroutine s9 (arg)
+ real, value, optional :: arg
+ !$omp parallel default(none) private (arg)
+ if (present (arg)) arg = 3
+ !$omp end parallel
+end subroutine
+
+subroutine s10 (arg)
+ real, optional :: arg(..)
+ !$omp parallel default(none) private (arg)
+ if (present (arg)) stop 10
+ !$omp end parallel
+end subroutine
+
+subroutine w1 (array)
+ real, optional :: array(:)
+ !$omp parallel default(none) ! { dg-error "enclosing 'parallel'" }
+ if (.not.present (array)) stop 1 ! { dg-error "'array' not specified in enclosing 'parallel'" }
+ !$omp end parallel
+end subroutine
+
+subroutine w2 (array2)
+ real, optional :: array2(*)
+ !$omp parallel default(none) ! { dg-error "enclosing 'parallel'" "TODO" { xfail *-*-* } }
+ if (.not.present (array2)) stop 2 ! { dg-error "'array2' not specified in enclosing 'parallel'" "TODO" { xfail *-*-* } }
+ !$omp end parallel
+end subroutine
+
+subroutine w3 (arg)
+ real, optional :: arg
+ !$omp parallel default(none) ! { dg-error "enclosing 'parallel'" }
+ if (.not.present (arg)) stop 3 ! { dg-error "'arg' not specified in enclosing 'parallel'" }
+ !$omp end parallel
+end subroutine
+
+subroutine w4 (arg2)
+ real, value, optional :: arg2
+ !$omp parallel default(none) ! { dg-error "enclosing 'parallel" "TODO" { xfail *-*-* } }
+ if (.not.present (arg2)) stop 4 ! { dg-error "'arg2' not specified in enclosing 'parallel'" "TODO" { xfail *-*-*} }
+ !$omp end parallel
+end subroutine
+
+subroutine w5 (array3)
+ real, optional :: array3(..)
+ !$omp parallel default(none) ! { dg-error "enclosing 'parallel'" }
+ if (.not.present (array3)) stop 5 ! { dg-error "'array3' not specified in enclosing 'parallel'" }
+ !$omp end parallel
+end subroutine
! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } }
! { dg-final { scan-tree-dump-times "explicit_shape2 \\(es1" 1 "original" } }
-! { dg-final { scan-tree-dump-times "= as1 != 0B" 2 "original" } }
+! { dg-final { scan-tree-dump-times "= as1.0 != 0B" 2 "original" } }
! { dg-final { scan-tree-dump-times "assumed_shape2 \\(as1" 0 "original" } }
! { dg-final { scan-tree-dump-times "explicit_shape2 \\(as1" 0 "original" } }
-
projects / gcc.git / commitdiff