CbC/CbC_gcc: gcc/fortran/trans-openmp.c comparison

comparison gcc/fortran/trans-openmp.c @ 145:1830386684a0

gcc-9.2.0

author	anatofuz
date	Thu, 13 Feb 2020 11:34:05 +0900
parents	84e7813d76e9
children

comparison

equal deleted inserted replaced

-:84e7813d76e9
+:1830386684a0
 /* OpenMP directive translation -- generate GCC trees from gfc_code.
-Copyright (C) 2005-2018 Free Software Foundation, Inc.
+Copyright (C) 2005-2020 Free Software Foundation, Inc.
 Contributed by Jakub Jelinek <jakub@redhat.com>
 This file is part of GCC.
 GCC is free software; you can redistribute it and/or modify it under
 #undef GCC_DIAG_STYLE
 #define GCC_DIAG_STYLE __gcc_tdiag__
 #include "diagnostic-core.h"
 #undef GCC_DIAG_STYLE
 #define GCC_DIAG_STYLE __gcc_gfc__
+#include "attribs.h"
 int ompws_flags;
+/* True if OpenMP should regard this DECL as being a scalar which has Fortran's
+allocatable or pointer attribute.  */
+bool
+gfc_omp_is_allocatable_or_ptr (const_tree decl)
+{
+return (DECL_P (decl)
+	  && (GFC_DECL_GET_SCALAR_POINTER (decl)
+	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)));
+}
+/* True if the argument is an optional argument; except that false is also
+returned for arguments with the value attribute (nonpointers) and for
+assumed-shape variables (decl is a local variable containing arg->data).
+Note that pvoid_type_node is for 'type(c_ptr), value.  */
+static bool
+gfc_omp_is_optional_argument (const_tree decl)
+{
+return (TREE_CODE (decl) == PARM_DECL
+	  && DECL_LANG_SPECIFIC (decl)
+	  && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+	  && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
+	  && GFC_DECL_OPTIONAL_ARGUMENT (decl));
+}
+/* Check whether this DECL belongs to a Fortran optional argument.
+With 'for_present_check' set to false, decls which are optional parameters
+themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
+always pointers.  With 'for_present_check' set to true, the decl for checking
+whether an argument is present is returned; for arguments with value
+attribute this is the hidden argument and of BOOLEAN_TYPE.  If the decl is
+unrelated to optional arguments, NULL_TREE is returned.  */
+tree
+gfc_omp_check_optional_argument (tree decl, bool for_present_check)
+{
+if (!for_present_check)
+return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
+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))))
+{
+is_array_type = true;
+decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+}
+if (decl == NULL_TREE
+|| TREE_CODE (decl) != PARM_DECL
+|| !DECL_LANG_SPECIFIC (decl)
+|| !GFC_DECL_OPTIONAL_ARGUMENT (decl))
+return NULL_TREE;
+/* Scalars with VALUE attribute which are passed by value use a hidden
+argument to denote the present status.  They are passed as nonpointer type
+with one exception: 'type(c_ptr), value' as 'void*'.  */
+/* Cf. trans-expr.c's gfc_conv_expr_present.  */
+if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
+|| VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
+{
+char name[GFC_MAX_SYMBOL_LEN + 2];
+tree tree_name;
+name[0] = '_';
+strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
+tree_name = get_identifier (name);
+/* Walk function argument list to find the hidden arg.  */
+decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
+for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
+	if (DECL_NAME (decl) == tree_name
+	    && DECL_ARTIFICIAL (decl))
+	  break;
+gcc_assert (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;
+}
+/* Returns tree with NULL if it is not an array descriptor and with the tree to
+access the 'data' component otherwise.  With type_only = true, it returns the
+TREE_TYPE without creating a new tree.  */
+tree
+gfc_omp_array_data (tree decl, bool type_only)
+{
+tree type = TREE_TYPE (decl);
+if (POINTER_TYPE_P (type))
+type = TREE_TYPE (type);
+if (!GFC_DESCRIPTOR_TYPE_P (type))
+return NULL_TREE;
+if (type_only)
+return GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
+if (POINTER_TYPE_P (TREE_TYPE (decl)))
+decl = build_fold_indirect_ref (decl);
+decl = gfc_conv_descriptor_data_get (decl);
+STRIP_NOPS (decl);
+return decl;
+}
 /* True if OpenMP should privatize what this DECL points to rather
 than the DECL itself.  */
 bool
 if (TREE_CODE (type) == REFERENCE_TYPE
 && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
 return true;
+if (TREE_CODE (type) == POINTER_TYPE
+&& gfc_omp_is_optional_argument (decl))
+return true;
 if (TREE_CODE (type) == POINTER_TYPE)
 {
+while (TREE_CODE (decl) == COMPONENT_REF)
+	decl = TREE_OPERAND (decl, 1);
 /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
 	 that have POINTER_TYPE type and aren't scalar pointers, scalar
 	 allocatables, Cray pointees or C pointers are supposed to be
 	 privatized by reference.  */
 if (GFC_DECL_GET_SCALAR_POINTER (decl)
 /* These are either array or derived parameters, or vtables.
 In the former cases, the OpenMP standard doesn't consider them to be
 variables at all (they can't be redefined), but they can nevertheless appear
 in parallel/task regions and for default(none) purposes treat them as shared.
 For vtables likely the same handling is desirable.  */
-if (VAR_P (decl) && TREE_READONLY (decl) && TREE_STATIC (decl))
+if (VAR_P (decl) && TREE_READONLY (decl)
+&& (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
 return OMP_CLAUSE_DEFAULT_SHARED;
 return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
 }
 				 gfc_array_index_type, tem,
 				 gfc_index_one_node);
 	}
 else
 	{
+	  bool compute_nelts = false;
 	  if (!TYPE_DOMAIN (type)
 	      || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
 	      || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
 	      || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
+	    compute_nelts = true;
+	  else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
+	    {
+	      tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
+	      if (lookup_attribute ("omp dummy var", a))
+		compute_nelts = true;
+	    }
+	  if (compute_nelts)
 	    {
 	      tem = fold_build2 (EXACT_DIV_EXPR, sizetype,
 				 TYPE_SIZE_UNIT (type),
 				 TYPE_SIZE_UNIT (TREE_TYPE (type)));
 	      tem = size_binop (MINUS_EXPR, tem, size_one_node);
 	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
 	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
 if ((! GFC_DESCRIPTOR_TYPE_P (type)
 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
-&& !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
+&& (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
+	  || !POINTER_TYPE_P (type)))
 {
 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
 	{
 	  gcc_assert (outer);
 	  gfc_start_block (&block);
 			      tem, null_pointer_node);
 gfc_add_expr_to_block (&block,
 			     build3_loc (input_location, COND_EXPR,
 					 void_type_node, cond, then_b,
 					 else_b));
+/* Avoid -W*uninitialized warnings.  */
+if (DECL_P (decl))
+	TREE_NO_WARNING (decl) = 1;
 }
 else
 gfc_add_expr_to_block (&block, then_b);
 return gfc_finish_block (&block);
 gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
 	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
 if ((! GFC_DESCRIPTOR_TYPE_P (type)
 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
-&& !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
+&& (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
+	  || !POINTER_TYPE_P (type)))
 {
 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
 	{
 	  gfc_start_block (&block);
 	  gfc_add_modify (&block, dest, src);
 cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
 			  unshare_expr (srcptr), null_pointer_node);
 gfc_add_expr_to_block (&block,
 			 build3_loc (input_location, COND_EXPR,
 				     void_type_node, cond, then_b, else_b));
+/* Avoid -W*uninitialized warnings.  */
+if (DECL_P (dest))
+TREE_NO_WARNING (dest) = 1;
 return gfc_finish_block (&block);
 }
 /* Similarly, except use an intrinsic or pointer assignment operator
 tree cond, then_b, else_b;
 stmtblock_t block, cond_block, cond_block2, inner_block;
 if ((! GFC_DESCRIPTOR_TYPE_P (type)
 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
-&& !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
+&& (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
+	  || !POINTER_TYPE_P (type)))
 {
 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
 	{
 	  gfc_start_block (&block);
 	  /* First dealloc any allocatable components in DEST.  */
 gfc_start_block (&block);
 add = gfc_evaluate_now (add, &block);
 if ((! GFC_DESCRIPTOR_TYPE_P (type)
 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
-&& !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
+&& (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
-{
+	  || !POINTER_TYPE_P (type)))
+{
+bool compute_nelts = false;
 gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
 if (!TYPE_DOMAIN (type)
 	  || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
 	  || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
 	  || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
+	compute_nelts = true;
+else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
+	{
+	  tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
+	  if (lookup_attribute ("omp dummy var", a))
+	    compute_nelts = true;
+	}
+if (compute_nelts)
 	{
 	  nelems = fold_build2 (EXACT_DIV_EXPR, sizetype,
 				TYPE_SIZE_UNIT (type),
 				TYPE_SIZE_UNIT (TREE_TYPE (type)));
 	  nelems = size_binop (MINUS_EXPR, nelems, size_one_node);
 {
 tree type = TREE_TYPE (decl), tem;
 if ((! GFC_DESCRIPTOR_TYPE_P (type)
 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
-&& !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
+&& (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
+	  || !POINTER_TYPE_P (type)))
 {
 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
 	return gfc_walk_alloc_comps (decl, NULL_TREE,
 				     OMP_CLAUSE_DECL (clause),
 				     WALK_ALLOC_COMPS_DTOR);
 			then_b, build_empty_stmt (input_location));
 }
 return tem;
 }
+/* Build a conditional expression in BLOCK.  If COND_VAL is not
+null, then the block THEN_B is executed, otherwise ELSE_VAL
+is assigned to VAL.  */
+static void
+gfc_build_cond_assign (stmtblock_t *block, tree val, tree cond_val,
+		       tree then_b, tree else_val)
+{
+stmtblock_t cond_block;
+tree else_b = NULL_TREE;
+tree val_ty = TREE_TYPE (val);
+if (else_val)
+{
+gfc_init_block (&cond_block);
+gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val));
+else_b = gfc_finish_block (&cond_block);
+}
+gfc_add_expr_to_block (block,
+			 build3_loc (input_location, COND_EXPR, void_type_node,
+				     cond_val, then_b, else_b));
+}
+/* Build a conditional expression in BLOCK, returning a temporary
+variable containing the result.  If COND_VAL is not null, then
+THEN_VAL will be assigned to the variable, otherwise ELSE_VAL
+is assigned.
+*/
+static tree
+gfc_build_cond_assign_expr (stmtblock_t *block, tree cond_val,
+			    tree then_val, tree else_val)
+{
+tree val;
+tree val_ty = TREE_TYPE (then_val);
+stmtblock_t cond_block;
+val = create_tmp_var (val_ty);
+gfc_init_block (&cond_block);
+gfc_add_modify (&cond_block, val, then_val);
+tree then_b = gfc_finish_block (&cond_block);
+gfc_build_cond_assign (block, val, cond_val, then_b, else_val);
+return val;
+}
 void
 gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
 {
 if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
 		"implicit mapping of assumed size array %qD", decl);
 return;
 }
 tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = 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)
 	  && !GFC_DECL_GET_SCALAR_POINTER (decl)
 	  && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
 	  && !GFC_DECL_CRAY_POINTEE (decl)
 	  && !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;
 OMP_CLAUSE_SIZE (c4) = size_int (0);
 decl = build_fold_indirect_ref (decl);
-OMP_CLAUSE_DECL (c) = decl;
+if (present
-OMP_CLAUSE_SIZE (c) = NULL_TREE;
+	  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
+	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
+	{
+	  c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+	  OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER);
+	  OMP_CLAUSE_DECL (c2) = decl;
+	  OMP_CLAUSE_SIZE (c2) = size_int (0);
+	  stmtblock_t block;
+	  gfc_start_block (&block);
+	  tree ptr = decl;
+	  ptr = gfc_build_cond_assign_expr (&block, present, decl,
+					    null_pointer_node);
+	  gimplify_and_add (gfc_finish_block (&block), pre_p);
+	  ptr = build_fold_indirect_ref (ptr);
+	  OMP_CLAUSE_DECL (c) = ptr;
+	  OMP_CLAUSE_SIZE (c) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
+	}
+else
+	{
+	  OMP_CLAUSE_DECL (c) = decl;
+	  OMP_CLAUSE_SIZE (c) = NULL_TREE;
+	}
 if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
 	  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
 	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
 	{
 	  c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
 {
 stmtblock_t block;
 gfc_start_block (&block);
 tree type = TREE_TYPE (decl);
 tree ptr = gfc_conv_descriptor_data_get (decl);
+if (present)
+	ptr = gfc_build_cond_assign_expr (&block, present, ptr,
+					  null_pointer_node);
 ptr = fold_convert (build_pointer_type (char_type_node), ptr);
 ptr = build_fold_indirect_ref (ptr);
 OMP_CLAUSE_DECL (c) = ptr;
 c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
 OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
-OMP_CLAUSE_DECL (c2) = decl;
+if (present)
+	{
+	  ptr = create_tmp_var (TREE_TYPE (TREE_OPERAND (decl, 0)));
+	  gfc_add_modify (&block, ptr, TREE_OPERAND (decl, 0));
+	  OMP_CLAUSE_DECL (c2) = build_fold_indirect_ref (ptr);
+	}
+else
+	OMP_CLAUSE_DECL (c2) = decl;
 OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
 c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
 OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
-OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
+if (present)
+	{
+	  ptr = gfc_conv_descriptor_data_get (decl);
+	  ptr = gfc_build_addr_expr (NULL, ptr);
+	  ptr = gfc_build_cond_assign_expr (&block, present,
+					    ptr, null_pointer_node);
+	  ptr = build_fold_indirect_ref (ptr);
+	  OMP_CLAUSE_DECL (c3) = ptr;
+	}
+else
+	OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
 OMP_CLAUSE_SIZE (c3) = size_int (0);
 tree size = create_tmp_var (gfc_array_index_type);
 tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
 elemsz = fold_convert (gfc_array_index_type, elemsz);
 if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
 	  gfc_add_modify (&cond_block, size, zero);
 	  else_b = gfc_finish_block (&cond_block);
 	  tem = gfc_conv_descriptor_data_get (decl);
 	  tem = fold_convert (pvoid_type_node, tem);
 	  cond = fold_build2_loc (input_location, NE_EXPR,
-				  logical_type_node, tem, null_pointer_node);
+				  boolean_type_node, tem, null_pointer_node);
+	  if (present)
+	    {
+	      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,
 						     void_type_node, cond,
 						     then_b, else_b));
+	}
+else if (present)
+	{
+	  stmtblock_t cond_block;
+	  tree then_b;
+	  gfc_init_block (&cond_block);
+	  gfc_add_modify (&cond_block, size,
+			  gfc_full_array_size (&cond_block, decl,
+					       GFC_TYPE_ARRAY_RANK (type)));
+	  gfc_add_modify (&cond_block, size,
+			  fold_build2 (MULT_EXPR, gfc_array_index_type,
+				       size, elemsz));
+	  then_b = gfc_finish_block (&cond_block);
+	  gfc_build_cond_assign (&block, size, present, then_b,
+				 build_int_cst (gfc_array_index_type, 0));
 	}
 else
 	{
 	  gfc_add_modify (&block, size,
 			  gfc_full_array_size (&block, decl,
 }
 if (c4)
 {
 OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last);
 OMP_CLAUSE_CHAIN (last) = c4;
-last = c4;
 }
 }
 /* Return true if DECL is a scalar variable (for the purpose of
 	type = TREE_TYPE (type);
 if (GFC_ARRAY_TYPE_P (type)
 	  || GFC_CLASS_TYPE_P (type))
 	return false;
 }
-if (TYPE_STRING_FLAG (type))
+if ((TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
+&& TYPE_STRING_FLAG (type))
 return false;
 if (INTEGRAL_TYPE_P (type)
 || SCALAR_FLOAT_TYPE_P (type)
 || COMPLEX_FLOAT_TYPE_P (type))
 return true;
 if (namelist->sym->attr.referenced)
 {
 	tree t = gfc_trans_omp_variable (namelist->sym, false);
 	if (t != error_mark_node)
 	  {
-	    tree node = build_omp_clause (where.lb->location,
+	    tree node = build_omp_clause (gfc_get_location (&namelist->where),
 					  OMP_CLAUSE_REDUCTION);
 	    OMP_CLAUSE_DECL (node) = t;
 	    if (mark_addressable)
 	      TREE_ADDRESSABLE (t) = 1;
 	    switch (namelist->u.reduction_op)
 return result;
 }
 static vec<tree, va_heap, vl_embed> *doacross_steps;
+/* Translate an array section or array element.  */
+static void
+gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
+			     tree decl, bool element, gomp_map_kind ptr_kind,
+			     tree node, tree &node2, tree &node3, tree &node4)
+{
+gfc_se se;
+tree ptr, ptr2;
+gfc_init_se (&se, NULL);
+if (element)
+{
+gfc_conv_expr_reference (&se, n->expr);
+gfc_add_block_to_block (block, &se.pre);
+ptr = se.expr;
+OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
+}
+else
+{
+gfc_conv_expr_descriptor (&se, n->expr);
+ptr = gfc_conv_array_data (se.expr);
+tree type = TREE_TYPE (se.expr);
+gfc_add_block_to_block (block, &se.pre);
+OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, se.expr,
+						    GFC_TYPE_ARRAY_RANK (type));
+tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+elemsz = fold_convert (gfc_array_index_type, elemsz);
+OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type,
+					    OMP_CLAUSE_SIZE (node), elemsz);
+}
+gfc_add_block_to_block (block, &se.post);
+ptr = fold_convert (build_pointer_type (char_type_node), ptr);
+OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
+if (POINTER_TYPE_P (TREE_TYPE (decl))
+&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
+&& ptr_kind == GOMP_MAP_POINTER)
+{
+node4 = build_omp_clause (input_location,
+				OMP_CLAUSE_MAP);
+OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
+OMP_CLAUSE_DECL (node4) = decl;
+OMP_CLAUSE_SIZE (node4) = size_int (0);
+decl = build_fold_indirect_ref (decl);
+}
+ptr = fold_convert (sizetype, ptr);
+if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+{
+tree type = TREE_TYPE (decl);
+ptr2 = gfc_conv_descriptor_data_get (decl);
+node2 = build_omp_clause (input_location,
+				OMP_CLAUSE_MAP);
+OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
+OMP_CLAUSE_DECL (node2) = decl;
+OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
+node3 = build_omp_clause (input_location,
+				OMP_CLAUSE_MAP);
+OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
+OMP_CLAUSE_DECL (node3)
+	= gfc_conv_descriptor_data_get (decl);
+if (ptr_kind == GOMP_MAP_ATTACH_DETACH)
+	STRIP_NOPS (OMP_CLAUSE_DECL (node3));
+}
+else
+{
+if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
+	ptr2 = build_fold_addr_expr (decl);
+else
+	{
+	  gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
+	  ptr2 = decl;
+	}
+node3 = build_omp_clause (input_location,
+				OMP_CLAUSE_MAP);
+OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
+OMP_CLAUSE_DECL (node3) = decl;
+}
+ptr2 = fold_convert (sizetype, ptr2);
+OMP_CLAUSE_SIZE (node3)
+= fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2);
+}
 static tree
 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		       locus where, bool declare_simd = false)
 {
 tree omp_clauses = NULL_TREE, chunk_size, c;
 	  clause_code = OMP_CLAUSE_UNIFORM;
 	  goto add_clause;
 	case OMP_LIST_USE_DEVICE:
 	case OMP_LIST_USE_DEVICE_PTR:
 	  clause_code = OMP_CLAUSE_USE_DEVICE_PTR;
+	  goto add_clause;
+	case OMP_LIST_USE_DEVICE_ADDR:
+	  clause_code = OMP_CLAUSE_USE_DEVICE_ADDR;
 	  goto add_clause;
 	case OMP_LIST_IS_DEVICE_PTR:
 	  clause_code = OMP_CLAUSE_IS_DEVICE_PTR;
 	  goto add_clause;
 		continue;
 	      tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
 	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
 		{
-		  tree decl = gfc_get_symbol_decl (n->sym);
+		  tree decl = gfc_trans_omp_variable (n->sym, false);
 		  if (gfc_omp_privatize_by_reference (decl))
 		    decl = build_fold_indirect_ref (decl);
 		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
 		    {
 		      decl = gfc_conv_descriptor_data_get (decl);
 	      tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
 	      tree node2 = NULL_TREE;
 	      tree node3 = NULL_TREE;
 	      tree node4 = NULL_TREE;
-	      tree decl = gfc_get_symbol_decl (n->sym);
+	      tree decl = gfc_trans_omp_variable (n->sym, false);
 	      if (DECL_P (decl))
 		TREE_ADDRESSABLE (decl) = 1;
-	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
+	      if (n->expr == NULL
+		  || (n->expr->ref->type == REF_ARRAY
+		      && n->expr->ref->u.ar.type == AR_FULL))
 		{
-		  if (POINTER_TYPE_P (TREE_TYPE (decl))
+		  tree present = gfc_omp_check_optional_argument (decl, true);
-		      && (gfc_omp_privatize_by_reference (decl)
+		  if (n->sym->ts.type == BT_CLASS)
-			  || GFC_DECL_GET_SCALAR_POINTER (decl)
+		    {
-			  || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
+		      tree type = TREE_TYPE (decl);
-			  || GFC_DECL_CRAY_POINTEE (decl)
+		      if (n->sym->attr.optional)
-			  || GFC_DESCRIPTOR_TYPE_P
+			sorry ("optional class parameter");
-					(TREE_TYPE (TREE_TYPE (decl)))))
+		      if (POINTER_TYPE_P (type))
+			{
+			  node4 = build_omp_clause (input_location,
+						    OMP_CLAUSE_MAP);
+			  OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
+			  OMP_CLAUSE_DECL (node4) = decl;
+			  OMP_CLAUSE_SIZE (node4) = size_int (0);
+			  decl = build_fold_indirect_ref (decl);
+			}
+		      tree ptr = gfc_class_data_get (decl);
+		      ptr = build_fold_indirect_ref (ptr);
+		      OMP_CLAUSE_DECL (node) = ptr;
+		      OMP_CLAUSE_SIZE (node) = gfc_class_vtab_size_get (decl);
+		      node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+		      OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
+		      OMP_CLAUSE_DECL (node2) = decl;
+		      OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
+		      node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+		      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH_DETACH);
+		      OMP_CLAUSE_DECL (node3) = gfc_class_data_get (decl);
+		      OMP_CLAUSE_SIZE (node3) = size_int (0);
+		      goto finalize_map_clause;
+		    }
+		  else if (POINTER_TYPE_P (TREE_TYPE (decl))
+			   && (gfc_omp_privatize_by_reference (decl)
+			       || GFC_DECL_GET_SCALAR_POINTER (decl)
+			       || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
+			       || GFC_DECL_CRAY_POINTEE (decl)
+			       || GFC_DESCRIPTOR_TYPE_P
+					     (TREE_TYPE (TREE_TYPE (decl)))
+			       || 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);
 		      OMP_CLAUSE_DECL (node4) = decl;
 		      OMP_CLAUSE_SIZE (node4) = size_int (0);
 		      decl = build_fold_indirect_ref (decl);
-		      if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
+		      if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
+			   || gfc_omp_is_optional_argument (orig_decl))
 			  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
 			      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
 			{
 			  node3 = build_omp_clause (input_location,
 						    OMP_CLAUSE_MAP);
 			  OMP_CLAUSE_DECL (node3) = decl;
 			  OMP_CLAUSE_SIZE (node3) = size_int (0);
 			  decl = build_fold_indirect_ref (decl);
 			}
 		    }
-		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
+		      && n->u.map_op != OMP_MAP_ATTACH
+		      && n->u.map_op != OMP_MAP_DETACH)
 		    {
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
+		      if (present)
+			ptr = gfc_build_cond_assign_expr (block, present, ptr,
+							  null_pointer_node);
 		      ptr = fold_convert (build_pointer_type (char_type_node),
 					  ptr);
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
 		      node2 = build_omp_clause (input_location,
 		      OMP_CLAUSE_DECL (node2) = decl;
 		      OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
 		      node3 = build_omp_clause (input_location,
 						OMP_CLAUSE_MAP);
 		      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
-		      OMP_CLAUSE_DECL (node3)
+		      if (present)
-			= gfc_conv_descriptor_data_get (decl);
+			{
+			  ptr = gfc_conv_descriptor_data_get (decl);
+			  ptr = gfc_build_addr_expr (NULL, ptr);
+			  ptr = gfc_build_cond_assign_expr (block, present, ptr,
+							    null_pointer_node);
+			  ptr = build_fold_indirect_ref (ptr);
+			  OMP_CLAUSE_DECL (node3) = ptr;
+			}
+		      else
+			OMP_CLAUSE_DECL (node3)
+			  = gfc_conv_descriptor_data_get (decl);
 		      OMP_CLAUSE_SIZE (node3) = size_int (0);
 		      /* We have to check for n->sym->attr.dimension because
 			 of scalar coarrays.  */
 		      if (n->sym->attr.pointer && n->sym->attr.dimension)
 			  gfc_add_modify (&cond_block, size, zero);
 			  else_b = gfc_finish_block (&cond_block);
 			  tem = gfc_conv_descriptor_data_get (decl);
 			  tem = fold_convert (pvoid_type_node, tem);
 			  cond = fold_build2_loc (input_location, NE_EXPR,
-						  logical_type_node,
+						  boolean_type_node,
 						  tem, null_pointer_node);
+			  if (present)
+			    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,
 							     void_type_node,
 							     cond, then_b,
 							     else_b));
 			  OMP_CLAUSE_SIZE (node) = size;
 			}
 		      else if (n->sym->attr.dimension)
-			OMP_CLAUSE_SIZE (node)
+			{
-			  = gfc_full_array_size (block, decl,
+			  stmtblock_t cond_block;
-						 GFC_TYPE_ARRAY_RANK (type));
+			  gfc_init_block (&cond_block);
+			  tree size = gfc_full_array_size (&cond_block, decl,
+					GFC_TYPE_ARRAY_RANK (type));
+			  if (present)
+			    {
+			      tree var = gfc_create_var (gfc_array_index_type,
+							 NULL);
+			      gfc_add_modify (&cond_block, var, size);
+			      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;
+			    }
+			  else
+			    {
+			      gfc_add_block_to_block (block, &cond_block);
+			      OMP_CLAUSE_SIZE (node) = size;
+			    }
+			}
 		      if (n->sym->attr.dimension)
 			{
 			  tree elemsz
 			    = TYPE_SIZE_UNIT (gfc_get_element_type (type));
 			  elemsz = fold_convert (gfc_array_index_type, elemsz);
 			  OMP_CLAUSE_SIZE (node)
 			    = fold_build2 (MULT_EXPR, gfc_array_index_type,
 					   OMP_CLAUSE_SIZE (node), elemsz);
 			}
 		    }
+		  else if (present
+			   && TREE_CODE (decl) == INDIRECT_REF
+			   && (TREE_CODE (TREE_OPERAND (decl, 0))
+			       == INDIRECT_REF))
+		    {
+		      /* A single indirectref is handled by the middle end.  */
+		      gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
+		      decl = TREE_OPERAND (decl, 0);
+		      decl = gfc_build_cond_assign_expr (block, present, decl,
+							 null_pointer_node);
+		      OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
+		    }
 		  else
 		    OMP_CLAUSE_DECL (node) = decl;
 		}
-	      else
+	      else if (n->expr
+		       && n->expr->expr_type == EXPR_VARIABLE
+		       && n->expr->ref->type == REF_COMPONENT)
 		{
-		  tree ptr, ptr2;
+		  gfc_ref *lastcomp;
+		  for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+		    if (ref->type == REF_COMPONENT)
+		      lastcomp = ref;
+		  symbol_attribute sym_attr;
+		  if (lastcomp->u.c.component->ts.type == BT_CLASS)
+		    sym_attr = CLASS_DATA (lastcomp->u.c.component)->attr;
+		  else
+		    sym_attr = lastcomp->u.c.component->attr;
 		  gfc_init_se (&se, NULL);
-		  if (n->expr->ref->u.ar.type == AR_ELEMENT)
+		  if (!sym_attr.dimension
+		      && lastcomp->u.c.component->ts.type != BT_CLASS
+		      && lastcomp->u.c.component->ts.type != BT_DERIVED)
 		    {
-		      gfc_conv_expr_reference (&se, n->expr);
+		      /* Last component is a scalar.  */
+		      gfc_conv_expr (&se, n->expr);
 		      gfc_add_block_to_block (block, &se.pre);
-		      ptr = se.expr;
+		      OMP_CLAUSE_DECL (node) = se.expr;
-		      OMP_CLAUSE_SIZE (node)
+		      gfc_add_block_to_block (block, &se.post);
-			= TYPE_SIZE_UNIT (TREE_TYPE (ptr));
+		      goto finalize_map_clause;
 		    }
-		  else
+		  se.expr = gfc_maybe_dereference_var (n->sym, decl);
+		  for (gfc_ref *ref = n->expr->ref;
+		       ref && ref != lastcomp->next;
+		       ref = ref->next)
 		    {
-		      gfc_conv_expr_descriptor (&se, n->expr);
+		      if (ref->type == REF_COMPONENT)
-		      ptr = gfc_conv_array_data (se.expr);
+			{
-		      tree type = TREE_TYPE (se.expr);
+			  if (ref->u.c.sym->attr.extension)
-		      gfc_add_block_to_block (block, &se.pre);
+			    conv_parent_component_references (&se, ref);
-		      OMP_CLAUSE_SIZE (node)
-			= gfc_full_array_size (block, se.expr,
+			  gfc_conv_component_ref (&se, ref);
-					       GFC_TYPE_ARRAY_RANK (type));
+			}
-		      tree elemsz
+		      else
-			= TYPE_SIZE_UNIT (gfc_get_element_type (type));
+			sorry ("unhandled derived-type component");
-		      elemsz = fold_convert (gfc_array_index_type, elemsz);
-		      OMP_CLAUSE_SIZE (node)
-			= fold_build2 (MULT_EXPR, gfc_array_index_type,
-				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
-		  gfc_add_block_to_block (block, &se.post);
-		  ptr = fold_convert (build_pointer_type (char_type_node),
+		  tree inner = se.expr;
-				      ptr);
-		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
+		  /* Last component is a derived type or class pointer.  */
+		  if (lastcomp->u.c.component->ts.type == BT_DERIVED
-		  if (POINTER_TYPE_P (TREE_TYPE (decl))
+		      || lastcomp->u.c.component->ts.type == BT_CLASS)
-		      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
 		    {
-		      node4 = build_omp_clause (input_location,
+		      if (sym_attr.allocatable || sym_attr.pointer)
-						OMP_CLAUSE_MAP);
+			{
-		      OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
+			  tree data, size;
-		      OMP_CLAUSE_DECL (node4) = decl;
-		      OMP_CLAUSE_SIZE (node4) = size_int (0);
+			  if (lastcomp->u.c.component->ts.type == BT_CLASS)
-		      decl = build_fold_indirect_ref (decl);
+			    {
-		    }
+			      data = gfc_class_data_get (inner);
-		  ptr = fold_convert (sizetype, ptr);
+			      size = gfc_class_vtab_size_get (inner);
-		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+			    }
-		    {
+			  else  /* BT_DERIVED.  */
-		      tree type = TREE_TYPE (decl);
+			    {
-		      ptr2 = gfc_conv_descriptor_data_get (decl);
+			      data = inner;
-		      node2 = build_omp_clause (input_location,
+			      size = TYPE_SIZE_UNIT (TREE_TYPE (inner));
-						OMP_CLAUSE_MAP);
+			    }
-		      OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
-		      OMP_CLAUSE_DECL (node2) = decl;
+			  OMP_CLAUSE_DECL (node)
-		      OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
+			    = build_fold_indirect_ref (data);
-		      node3 = build_omp_clause (input_location,
+			  OMP_CLAUSE_SIZE (node) = size;
-						OMP_CLAUSE_MAP);
+			  node2 = build_omp_clause (input_location,
-		      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
+						    OMP_CLAUSE_MAP);
-		      OMP_CLAUSE_DECL (node3)
+			  OMP_CLAUSE_SET_MAP_KIND (node2,
-			= gfc_conv_descriptor_data_get (decl);
+						   GOMP_MAP_ATTACH_DETACH);
-		    }
+			  OMP_CLAUSE_DECL (node2) = data;
-		  else
+			  OMP_CLAUSE_SIZE (node2) = size_int (0);
-		    {
+			}
-		      if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
-			ptr2 = build_fold_addr_expr (decl);
 		      else
 			{
-			  gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
+			  OMP_CLAUSE_DECL (node) = decl;
-			  ptr2 = decl;
+			  OMP_CLAUSE_SIZE (node)
+			    = TYPE_SIZE_UNIT (TREE_TYPE (decl));
 			}
-		      node3 = build_omp_clause (input_location,
-						OMP_CLAUSE_MAP);
-		      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
-		      OMP_CLAUSE_DECL (node3) = decl;
 		    }
-		  ptr2 = fold_convert (sizetype, ptr2);
+		  else if (lastcomp->next
-		  OMP_CLAUSE_SIZE (node3)
+			   && lastcomp->next->type == REF_ARRAY
-		    = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2);
+			   && lastcomp->next->u.ar.type == AR_FULL)
+		    {
+		      /* Just pass the (auto-dereferenced) decl through for
+			 bare attach and detach clauses.  */
+		      if (n->u.map_op == OMP_MAP_ATTACH
+			  || n->u.map_op == OMP_MAP_DETACH)
+			{
+			  OMP_CLAUSE_DECL (node) = inner;
+			  OMP_CLAUSE_SIZE (node) = size_zero_node;
+			  goto finalize_map_clause;
+			}
+		      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
+			{
+			  tree type = TREE_TYPE (inner);
+			  tree ptr = gfc_conv_descriptor_data_get (inner);
+			  ptr = build_fold_indirect_ref (ptr);
+			  OMP_CLAUSE_DECL (node) = ptr;
+			  node2 = build_omp_clause (input_location,
+						    OMP_CLAUSE_MAP);
+			  OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
+			  OMP_CLAUSE_DECL (node2) = inner;
+			  OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
+			  node3 = build_omp_clause (input_location,
+						    OMP_CLAUSE_MAP);
+			  OMP_CLAUSE_SET_MAP_KIND (node3,
+						   GOMP_MAP_ATTACH_DETACH);
+			  OMP_CLAUSE_DECL (node3)
+			    = gfc_conv_descriptor_data_get (inner);
+			  STRIP_NOPS (OMP_CLAUSE_DECL (node3));
+			  OMP_CLAUSE_SIZE (node3) = size_int (0);
+			  int rank = GFC_TYPE_ARRAY_RANK (type);
+			  OMP_CLAUSE_SIZE (node)
+			    = gfc_full_array_size (block, inner, rank);
+			  tree elemsz
+			    = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+			  elemsz = fold_convert (gfc_array_index_type, elemsz);
+			  OMP_CLAUSE_SIZE (node)
+			    = fold_build2 (MULT_EXPR, gfc_array_index_type,
+					   OMP_CLAUSE_SIZE (node), elemsz);
+			}
+		      else
+			OMP_CLAUSE_DECL (node) = inner;
+		    }
+		  else  /* An array element or section.  */
+		    {
+		      bool element
+			= (lastcomp->next
+			   && lastcomp->next->type == REF_ARRAY
+			   && lastcomp->next->u.ar.type == AR_ELEMENT);
+		      gfc_trans_omp_array_section (block, n, inner, element,
+						   GOMP_MAP_ATTACH_DETACH,
+						   node, node2, node3, node4);
+		    }
 		}
+	      else  /* An array element or array section.  */
+		{
+		  bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
+		  gfc_trans_omp_array_section (block, n, decl, element,
+					       GOMP_MAP_POINTER, node, node2,
+					       node3, node4);
+		}
+	      finalize_map_clause:
 	      switch (n->u.map_op)
 		{
 		case OMP_MAP_ALLOC:
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
+		  break;
+		case OMP_MAP_IF_PRESENT:
+		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_IF_PRESENT);
+		  break;
+		case OMP_MAP_ATTACH:
+		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ATTACH);
 		  break;
 		case OMP_MAP_TO:
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO);
 		  break;
 		case OMP_MAP_FROM:
 		case OMP_MAP_RELEASE:
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE);
 		  break;
 		case OMP_MAP_DELETE:
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE);
+		  break;
+		case OMP_MAP_DETACH:
+		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DETACH);
 		  break;
 		case OMP_MAP_FORCE_ALLOC:
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_ALLOC);
 		  break;
 		case OMP_MAP_FORCE_TO:
 		  gcc_unreachable ();
 		}
 	      tree node = build_omp_clause (input_location, clause_code);
 	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
 		{
-		  tree decl = gfc_get_symbol_decl (n->sym);
+		  tree decl = gfc_trans_omp_variable (n->sym, false);
 		  if (gfc_omp_privatize_by_reference (decl))
-		    decl = build_fold_indirect_ref (decl);
+		    {
+		      if (gfc_omp_is_allocatable_or_ptr (decl))
+			decl = build_fold_indirect_ref (decl);
+		      decl = build_fold_indirect_ref (decl);
+		    }
 		  else if (DECL_P (decl))
 		    TREE_ADDRESSABLE (decl) = 1;
 		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
 		    {
 		      tree type = TREE_TYPE (decl);
 		      OMP_CLAUSE_SIZE (node)
 			= fold_build2 (MULT_EXPR, gfc_array_index_type,
 				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
 		  else
-		    OMP_CLAUSE_DECL (node) = decl;
+		    {
+		      OMP_CLAUSE_DECL (node) = decl;
+		      if (gfc_omp_is_allocatable_or_ptr (decl))
+			OMP_CLAUSE_SIZE (node)
+				= TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
+		    }
 		}
 	      else
 		{
 		  tree ptr;
 		  gfc_init_se (&se, NULL);
 gfc_conv_expr (&se, clauses->if_expr);
 gfc_add_block_to_block (block, &se.pre);
 if_var = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
 OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
 OMP_CLAUSE_IF_EXPR (c) = if_var;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
 	gfc_conv_expr (&se, clauses->if_exprs[ifc]);
 	gfc_add_block_to_block (block, &se.pre);
 	if_var = gfc_evaluate_now (se.expr, block);
 	gfc_add_block_to_block (block, &se.post);
-	c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
+	c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
 	switch (ifc)
 	  {
 	  case OMP_IF_PARALLEL:
 	    OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL;
 	    break;
 gfc_conv_expr (&se, clauses->final_expr);
 gfc_add_block_to_block (block, &se.pre);
 final_var = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINAL);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL);
 OMP_CLAUSE_FINAL_EXPR (c) = final_var;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->num_threads)
 gfc_conv_expr (&se, clauses->num_threads);
 gfc_add_block_to_block (block, &se.pre);
 num_threads = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS);
 OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 chunk_size = NULL_TREE;
 gfc_add_block_to_block (block, &se.post);
 }
 if (clauses->sched_kind != OMP_SCHED_NONE)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE);
 OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
 switch (clauses->sched_kind)
 	{
 	case OMP_SCHED_STATIC:
 	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT);
 switch (clauses->default_sharing)
 	{
 	case OMP_DEFAULT_NONE:
 	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
 	  break;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->nowait)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->ordered)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
 OMP_CLAUSE_ORDERED_EXPR (c)
 	= clauses->orderedc ? build_int_cst (integer_type_node,
 					     clauses->orderedc) : NULL_TREE;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->untied)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->mergeable)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_MERGEABLE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->collapse)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE);
 OMP_CLAUSE_COLLAPSE_EXPR (c)
 	= build_int_cst (integer_type_node, clauses->collapse);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->inbranch)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->notinbranch)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 switch (clauses->cancel)
 {
 case OMP_CANCEL_UNKNOWN:
 break;
 case OMP_CANCEL_PARALLEL:
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 break;
 case OMP_CANCEL_SECTIONS:
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 break;
 case OMP_CANCEL_DO:
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 break;
 case OMP_CANCEL_TASKGROUP:
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 break;
 }
 if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
 switch (clauses->proc_bind)
 	{
 	case OMP_PROC_BIND_MASTER:
 	  OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
 	  break;
 gfc_conv_expr (&se, clauses->safelen_expr);
 gfc_add_block_to_block (block, &se.pre);
 safelen_var = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN);
 OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->simdlen_expr)
 {
 if (declare_simd)
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
 	  OMP_CLAUSE_SIMDLEN_EXPR (c)
 	    = gfc_conv_constant_to_tree (clauses->simdlen_expr);
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
 else
 	  gfc_conv_expr (&se, clauses->simdlen_expr);
 	  gfc_add_block_to_block (block, &se.pre);
 	  simdlen_var = gfc_evaluate_now (se.expr, block);
 	  gfc_add_block_to_block (block, &se.post);
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
 	  OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
 }
 gfc_conv_expr (&se, clauses->num_teams);
 gfc_add_block_to_block (block, &se.pre);
 num_teams = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
 OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->device)
 gfc_conv_expr (&se, clauses->device);
 gfc_add_block_to_block (block, &se.pre);
 device = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
 OMP_CLAUSE_DEVICE_ID (c) = device;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->thread_limit)
 gfc_conv_expr (&se, clauses->thread_limit);
 gfc_add_block_to_block (block, &se.pre);
 thread_limit = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT);
 OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 chunk_size = NULL_TREE;
 gfc_add_block_to_block (block, &se.post);
 }
 if (clauses->dist_sched_kind != OMP_SCHED_NONE)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE);
+c = build_omp_clause (gfc_get_location (&where),
+			    OMP_CLAUSE_DIST_SCHEDULE);
 OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->grainsize)
 gfc_conv_expr (&se, clauses->grainsize);
 gfc_add_block_to_block (block, &se.pre);
 grainsize = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
 OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->num_tasks)
 gfc_conv_expr (&se, clauses->num_tasks);
 gfc_add_block_to_block (block, &se.pre);
 num_tasks = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
 OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->priority)
 gfc_conv_expr (&se, clauses->priority);
 gfc_add_block_to_block (block, &se.pre);
 priority = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY);
 OMP_CLAUSE_PRIORITY_EXPR (c) = priority;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->hint)
 gfc_conv_expr (&se, clauses->hint);
 gfc_add_block_to_block (block, &se.pre);
 hint = gfc_evaluate_now (se.expr, block);
 gfc_add_block_to_block (block, &se.post);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT);
 OMP_CLAUSE_HINT_EXPR (c) = hint;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->simd)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->threads)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->nogroup)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->defaultmap)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
+OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
+				      OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->depend_source)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
 OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->async)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC);
 if (clauses->async_expr)
 	OMP_CLAUSE_ASYNC_EXPR (c)
 	  = gfc_convert_expr_to_tree (block, clauses->async_expr);
 else
 	OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->seq)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_SEQ);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->par_auto)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->if_present)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF_PRESENT);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->finalize)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINALIZE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->independent)
 {
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->wait_list)
 {
 gfc_expr_list *el;
 for (el = clauses->wait_list; el; el = el->next)
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT);
 	  OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
 	  OMP_CLAUSE_CHAIN (c) = omp_clauses;
 	  omp_clauses = c;
 	}
 }
 if (clauses->num_gangs_expr)
 {
 tree num_gangs_var
 	= gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS);
 OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->num_workers_expr)
 {
 tree num_workers_var
 	= gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS);
 OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->vector_length_expr)
 {
 tree vector_length_var
 	= gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH);
 OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 }
 if (clauses->tile_list)
 {
 vec_alloc (tvec, 4);
 for (el = clauses->tile_list; el; el = el->next)
 	vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_TILE);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE);
 OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 tvec->truncate (0);
 }
 if (clauses->vector)
 {
 if (clauses->vector_expr)
 	{
 	  tree vector_var
 	    = gfc_convert_expr_to_tree (block, clauses->vector_expr);
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
 	  OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
 else
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
 }
 if (clauses->worker)
 {
 if (clauses->worker_expr)
 	{
 	  tree worker_var
 	    = gfc_convert_expr_to_tree (block, clauses->worker_expr);
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
 	  OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
 else
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
 }
 if (clauses->gang)
 {
 tree arg;
-c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
+c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 if (clauses->gang_num_expr)
 	{
 	  arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
 	  OMP_CLAUSE_GANG_EXPR (c) = arg;
 else
 poplevel (0, 0);
 return stmt;
 }
-/* Trans OpenACC directives. */
+/* Translate OpenACC 'parallel', 'kernels', 'serial', 'data', 'host_data'
-/* parallel, kernels, data and host_data. */
+construct. */
 static tree
 gfc_trans_oacc_construct (gfc_code *code)
 {
 stmtblock_t block;
 tree stmt, oacc_clauses;
 case EXEC_OACC_PARALLEL:
 	construct_code = OACC_PARALLEL;
 	break;
 case EXEC_OACC_KERNELS:
 	construct_code = OACC_KERNELS;
+	break;
+case EXEC_OACC_SERIAL:
+	construct_code = OACC_SERIAL;
 	break;
 case EXEC_OACC_DATA:
 	construct_code = OACC_DATA;
 	break;
 case EXEC_OACC_HOST_DATA:
 stmtblock_t block;
 tree lhsaddr, type, rhs, x;
 enum tree_code op = ERROR_MARK;
 enum tree_code aop = OMP_ATOMIC;
 bool var_on_left = false;
-bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0;
+enum omp_memory_order mo
+= ((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST)
+? OMP_MEMORY_ORDER_SEQ_CST : OMP_MEMORY_ORDER_RELAXED);
 code = code->block->next;
 gcc_assert (code->op == EXEC_ASSIGN);
 var = code->expr1->symtree->n.sym;
 gfc_start_block (&block);
 expr2 = code->expr2;
 if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
 != GFC_OMP_ATOMIC_WRITE)
-&& (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP) == 0
 && expr2->expr_type == EXPR_FUNCTION
 && expr2->value.function.isym
 && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
 expr2 = expr2->value.function.actual->expr;
 gfc_add_block_to_block (&block, &lse.pre);
 type = TREE_TYPE (lse.expr);
 lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
 x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
-OMP_ATOMIC_SEQ_CST (x) = seq_cst;
+OMP_ATOMIC_MEMORY_ORDER (x) = mo;
 x = convert (TREE_TYPE (vse.expr), x);
 gfc_add_modify (&block, vse.expr, x);
 gfc_add_block_to_block (&block, &lse.pre);
 gfc_add_block_to_block (&block, &rse.pre);
 gfc_add_block_to_block (&block, &rse.pre);
 if (aop == OMP_ATOMIC)
 {
 x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
-OMP_ATOMIC_SEQ_CST (x) = seq_cst;
+OMP_ATOMIC_MEMORY_ORDER (x) = mo;
 gfc_add_expr_to_block (&block, x);
 }
 else
 {
 if (aop == OMP_ATOMIC_CAPTURE_NEW)
 	  gfc_init_se (&lse, NULL);
 	  gfc_conv_expr (&lse, expr2);
 	  gfc_add_block_to_block (&block, &lse.pre);
 	}
 x = build2 (aop, type, lhsaddr, convert (type, x));
-OMP_ATOMIC_SEQ_CST (x) = seq_cst;
+OMP_ATOMIC_MEMORY_ORDER (x) = mo;
 x = convert (TREE_TYPE (vse.expr), x);
 gfc_add_modify (&block, vse.expr, x);
 }
 return gfc_finish_block (&block);
 doacross_steps = saved_doacross_steps;
 return gfc_finish_block (&block);
 }
-/* parallel loop and kernels loop. */
+/* Translate combined OpenACC 'parallel loop', 'kernels loop', 'serial loop'
+construct. */
 static tree
 gfc_trans_oacc_combined_directive (gfc_code *code)
 {
 stmtblock_t block, *pblock = NULL;
 gfc_omp_clauses construct_clauses, loop_clauses;
 tree stmt, oacc_clauses = NULL_TREE;
 enum tree_code construct_code;
+location_t loc = input_location;
 switch (code->op)
 {
 case EXEC_OACC_PARALLEL_LOOP:
 	construct_code = OACC_PARALLEL;
 	break;
 case EXEC_OACC_KERNELS_LOOP:
 	construct_code = OACC_KERNELS;
+	break;
+case EXEC_OACC_SERIAL_LOOP:
+	construct_code = OACC_SERIAL;
 	break;
 default:
 	gcc_unreachable ();
 }
 if (!loop_clauses.seq)
 pblock = &block;
 else
 pushlevel ();
 stmt = gfc_trans_omp_do (code, EXEC_OACC_LOOP, pblock, &loop_clauses, NULL);
+protected_set_expr_location (stmt, loc);
 if (TREE_CODE (stmt) != BIND_EXPR)
 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
 else
 poplevel (0, 0);
-stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+stmt = build2_loc (loc, construct_code, void_type_node, stmt, oacc_clauses);
-		     oacc_clauses);
 gfc_add_expr_to_block (&block, stmt);
 return gfc_finish_block (&block);
 }
 static tree
 }
 static tree
 gfc_trans_omp_taskgroup (gfc_code *code)
 {
-tree stmt = gfc_trans_code (code->block->next);
+tree body = gfc_trans_code (code->block->next);
-return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt);
+tree stmt = make_node (OMP_TASKGROUP);
+TREE_TYPE (stmt) = void_type_node;
+OMP_TASKGROUP_BODY (stmt) = body;
+OMP_TASKGROUP_CLAUSES (stmt) = NULL_TREE;
+return stmt;
 }
 static tree
 gfc_trans_omp_taskwait (void)
 {
 {
 clausesa = clausesa_buf;
 gfc_split_omp_clauses (code, clausesa);
 }
 if (flag_openmp)
-omp_clauses
+{
-= chainon (omp_clauses,
+omp_clauses
-		 gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS],
+	= chainon (omp_clauses,
-					code->loc));
+		   gfc_trans_omp_clauses (&block,
+					  &clausesa[GFC_OMP_SPLIT_TEAMS],
+					  code->loc));
+pushlevel ();
+}
 switch (code->op)
 {
 case EXEC_OMP_TARGET_TEAMS:
 case EXEC_OMP_TEAMS:
 stmt = gfc_trans_omp_code (code->block->next, true);
 stmt = gfc_trans_omp_distribute (code, clausesa);
 break;
 }
 if (flag_openmp)
 {
+stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
 stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
 			 omp_clauses);
 if (combined)
 	OMP_TEAMS_COMBINED (stmt) = 1;
 }
 break;
 case EXEC_OMP_TARGET_PARALLEL:
 {
 	stmtblock_t iblock;
+	pushlevel ();
 	gfc_start_block (&iblock);
 	tree inner_clauses
 	  = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
 				   code->loc);
 	stmt = gfc_trans_omp_code (code->block->next, true);
 {
 switch (code->op)
 {
 case EXEC_OACC_PARALLEL_LOOP:
 case EXEC_OACC_KERNELS_LOOP:
+case EXEC_OACC_SERIAL_LOOP:
 return gfc_trans_oacc_combined_directive (code);
 case EXEC_OACC_PARALLEL:
 case EXEC_OACC_KERNELS:
+case EXEC_OACC_SERIAL:
 case EXEC_OACC_DATA:
 case EXEC_OACC_HOST_DATA:
 return gfc_trans_oacc_construct (code);
 case EXEC_OACC_LOOP:
 return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,

Mercurial > hg > CbC > CbC_gcc

comparison gcc/fortran/trans-openmp.c @ 145:1830386684a0