backport: re PR fortran/46752 (OpenMP - Seg fault for unallocated allocatable array in firstprivate clause)

Merge from gomp-3_1-branch branch:

2011-08-02  Jakub Jelinek  <jakub@redhat.com>

gcc/
	* c-parser.c (enum c_parser_prec): New enum, moved from within
	c_parser_binary_expression.
	(c_parser_binary_expression): Add PREC argument.  Stop parsing
	if operator has lower or equal precedence than PREC.
	(c_parser_conditional_expression, c_parser_omp_for_loop): Adjust
	callers.
	(c_parser_omp_atomic): Handle parsing OpenMP 3.1 atomics.
	Adjust c_finish_omp_atomic caller.
	(c_parser_omp_taskyield): New function.
	(c_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
	(c_parser_omp_clause_name): Handle final and mergeable clauses.
	(c_parser_omp_clause_final, c_parser_omp_clause_mergeable): New
	functions.
	(c_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
	and PRAGMA_OMP_CLAUSE_MERGEABLE.
	(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
	(c_parser_omp_clause_reduction): Handle min and max.
	* c-typeck.c (c_finish_omp_clauses): Don't complain about
	const qualified predetermined vars in firstprivate clause.
	andle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
	Handle MIN_EXPR and MAX_EXPR.
	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_FINAL
	and OMP_CLAUSE_MERGEABLE.
	(dump_generic_node): Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD
	and OMP_ATOMIC_CAPTURE_NEW.
	* tree.c (omp_clause_num_ops): Add OMP_CLAUSE_FINAL and
	OMP_CLAUSE_MERGEABLE.
	(omp_clause_code_name): Likewise.
	(walk_tree_1): Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
	* tree.h (enum omp_clause_code): Add OMP_CLAUSE_FINAL
	and OMP_CLAUSE_MERGEABLE.
	(OMP_CLAUSE_FINAL_EXPR): Define.
	* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_FINAL and
	OMP_CLAUSE_MERGEABLE.
	(expand_task_call): Likewise.
	(expand_omp_atomic_load, expand_omp_atomic_store): New functions.
	(expand_omp_atomic_fetch_op): Handle cases where old or new
	value is needed afterwards.
	(expand_omp_atomic): Call expand_omp_atomic_load resp.
	expand_omp_atomic_store.
	* gimplify.c (gimplify_omp_atomic, gimplify_expr): Handle
	OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and OMP_ATOMIC_CAPTURE_NEW.
	(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
	OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
	* tree-nested.c (convert_nonlocal_omp_clauses,
	convert_local_omp_clauses): Likewise.
	* tree.def (OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD,
	OMP_ATOMIC_CAPTURE_NEW): New.
	* gimple.h (GF_OMP_ATOMIC_NEED_VALUE): New.
	(gimple_omp_atomic_need_value_p, gimple_omp_atomic_set_need_value):
	New inlines.
	* omp-builtins.def (BUILT_IN_GOMP_TASKYIELD): New builtin.
	* doc/generic.texi: Mention OMP_CLAUSE_COLLAPSE,
	OMP_CLAUSE_UNTIED, OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
gcc/c-family/
	* c-common.h (c_finish_omp_atomic): Adjust prototype.
	(c_finish_omp_taskyield): New prototype.
	* c-omp.c (c_finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
	arguments. Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and
	OMP_ATOMIC_CAPTURE_NEW in addition to OMP_ATOMIC.  If LHS1
	or RHS1 have side-effects, evaluate those too in the right spot,
	if it is a decl and LHS is also a decl, error out if they
	aren't the same.
	(c_finish_omp_taskyield): New function.
	* c-cppbuiltin.c (c_cpp_builtins): Change _OPENMP to 201107.
	* c-pragma.c (omp_pragmas): Add taskyield.
	* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_TASKYIELD.
	(enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_FINAL and
	PRAGMA_OMP_CLAUSE_MERGEABLE.
gcc/cp/
	* cp-tree.h (finish_omp_atomic): Adjust prototype.
	(cxx_omp_const_qual_no_mutable): New prototype.
	(finish_omp_taskyield): New prototype.
	* parser.c (cp_parser_omp_atomic): (cp_parser_omp_atomic): Handle
	parsing OpenMP 3.1 atomics.  Adjust finish_omp_atomic caller.
	(cp_parser_omp_clause_name): Handle final and mergeable clauses.
	(cp_parser_omp_clause_final, cp_parser_omp_clause_mergeable): New
	functions.
	(cp_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
	and PRAGMA_OMP_CLAUSE_MERGEABLE.
	(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
	(cp_parser_omp_taskyield): New function.
	(cp_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
	(cp_parser_omp_clause_reduction): Handle min and max.
	* pt.c (tsubst_expr) <case OMP_ATOMIC>: Handle OpenMP 3.1 atomics.
	(tsubst_omp_clauses): Handle OMP_CLAUSE_FINAL and
	OMP_CLAUSE_MERGEABLE.
	* semantics.c (finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
	arguments.  Handle OpenMP 3.1 atomics.  Adjust c_finish_omp_atomic
	caller.
	(finish_omp_clauses): Don't complain about const qualified
	predetermined vars and static data members in firstprivate clause.
	Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE. Handle MIN_EXPR
	and MAX_EXPR.
	(finish_omp_taskyield): New function.
	* cp-gimplify.c (cxx_omp_const_qual_no_mutable): New function.
	(cxx_omp_predetermined_sharing): Use it.
gcc/fortran/
	PR fortran/46752
	* cpp.c (cpp_define_builtins): Change _OPENMP to 201107.
	* openmp.c (gfc_free_omp_clauses): Free also final_expr.
	(OMP_CLAUSE_FINAL, OMP_CLAUSE_MERGEABLE): Define.
	(gfc_match_omp_clauses): Handle parsing final and mergeable
	clauses.
	(OMP_TASK_CLAUSES): Allow final and mergeable clauses.
	(gfc_match_omp_taskyield): New function.
	(resolve_omp_clauses): Resolve final clause.  Allow POINTERs and
	Cray pointers in clauses other than REDUCTION.
	(gfc_match_omp_atomic): Match optional
	read/write/update/capture keywords after !$omp atomic.
	(resolve_omp_atomic): Handle all OpenMP 3.1 atomic forms.
	* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_TASKYIELD,
	print final and mergeable clauses.
	(show_code_node): Handle EXEC_OMP_TASKYIELD.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle final and
	mergeable clauses.
	(gfc_trans_omp_taskyield): New function.
	(gfc_trans_omp_directive): Handle EXEC_OMP_TASKYIELD.
	(gfc_trans_omp_atomic): Handle all OpenMP 3.1 atomic forms.
	(gfc_omp_clause_copy_ctor): Handle non-allocated allocatable.
	(gfc_omp_predetermined_sharing): Adjust comment.
	* gfortran.h (gfc_statement): Add ST_OMP_TASKYIELD and
	ST_OMP_END_ATOMIC.
	(gfc_omp_clauses): Add final_expr and mergeable fields.
	(gfc_exec_op): Add EXEC_OMP_TASKYIELD.
	(gfc_omp_atomic_op): New enum typedef.
	(struct gfc_code): Add ext.omp_atomic.
	* trans.c (trans_code): Handle EXEC_OMP_TASKYIELD.
	* frontend-passes.c (gfc_code_walker): Also walk final_expr.
	* resolve.c (gfc_resolve_blocks, resolve_code): Handle
	EXEC_OMP_TASKYIELD.
	* st.c (gfc_free_statement): Likewise.
	* match.h (gfc_match_omp_taskyield): New prototype.
	* parse.c (decode_omp_directive): Handle taskyield directive.
	Handle !$omp end atomic.
	(case_executable): Add ST_OMP_TASKYIELD case.
	(gfc_ascii_statement): Handle ST_OMP_TASKYIELD.
	(parse_omp_atomic): Return gfc_statement instead of void.
	For !$omp atomic capture parse two assignments instead of
	just one and require !$omp end atomic afterwards, for
	other !$omp atomic forms just allow !$omp end atomic at the
	end.
	(parse_omp_structured_block, parse_executable): Adjust
	parse_omp_atomic callers.

2011-08-02  Tobias Burnus  <burnus@net-b.de>

	* intrinsic.c (OMP_LIB): Updated openmp_version's
	value to 201107.
	* gfortran.texi (OpenMP): Update ref to OpenMP 3.1.
	* intrinsic.texi (OpenMP Modules): Update ref to OpenMP 3.1;
	remove deleted omp_integer_kind and omp_logical_kind constants.
gcc/testsuite/
	PR fortran/46752
	* gcc.dg/gomp/atomic-5.c: Adjust expected diagnostics.
	* gcc.dg/gomp/atomic-15.c: New test.
	* g++.dg/gomp/atomic-5.C: Adjust expected diagnostics.
	* g++.dg/gomp/atomic-15.C: New test.
	* g++.dg/gomp/private-1.C: New test.
	* g++.dg/gomp/sharing-2.C: New test.
	* gfortran.dg/gomp/crayptr1.f90: Don't expect error
	about Cray pointer in FIRSTPRIVATE/LASTPRIVATE.
	* gfortran.dg/gomp/omp_atomic2.f90: New test.
libgomp/
	PR fortran/42041
	PR fortran/46752
	* omp.h.in (omp_in_final): New prototype.
	* omp_lib.f90.in (omp_in_final): New interface.
	(omp_integer_kind, omp_logical_kind): Remove
	and replace all its uses in the module with 4.
	(openmp_version): Change to 201107.
	* omp_lib.h.in (omp_sched_static, omp_sched_dynamic,
	omp_sched_guided, omp_sched_auto): Use omp_sched_kind
	kind for the parameters.
	(omp_in_final): New external.
	(openmp_version): Change to 201107.
	* task.c (omp_in_final): New function.
	(gomp_init_task): Initialize final_task.
	(GOMP_task): Remove unused attribute from flags.  Handle final
	tasks.
	(GOMP_taskyield): New function.
	(omp_in_final): Return true if if (false) or final (true) task
	or descendant of final (true).
	* fortran.c (omp_in_final_): New function.
	* libgomp.map (OMP_3.1): Export omp_in_final and omp_in_final_.
	(GOMP_3.0): Export GOMP_taskyield.
	* env.c (gomp_nthreads_var_list, gomp_nthreads_var_list_len): New
	variables.
	(parse_unsigned_long_list): New function.
	(initialize_env): Use it for OMP_NUM_THREADS.  Call parse_boolean
	with "OMP_PROC_BIND".  If OMP_PROC_BIND=true, call gomp_init_affinity
	even if parse_affinity returned false.
	* config/linux/affinity.c (gomp_init_affinity): Handle
	gomp_cpu_affinity_len == 0.
	* libgomp_g.h (GOMP_taskyield): New prototype.
	* libgomp.h (struct gomp_task): Add final_task field.
	(gomp_nthreads_var_list, gomp_nthreads_var_list_len): New externs.
	* team.c (gomp_team_start): Override new task's nthreads_var icv
	if list form OMP_NUM_THREADS has been used and it has value for
	the new nesting level.

	* testsuite/libgomp.c/atomic-11.c: New test.
	* testsuite/libgomp.c/atomic-12.c: New test.
	* testsuite/libgomp.c/atomic-13.c: New test.
	* testsuite/libgomp.c/atomic-14.c: New test.
	* testsuite/libgomp.c/reduction-6.c: New test.
	* testsuite/libgomp.c/task-5.c: New test.
	* testsuite/libgomp.c++/atomic-2.C: New test.
	* testsuite/libgomp.c++/atomic-3.C: New test.
	* testsuite/libgomp.c++/atomic-4.C: New test.
	* testsuite/libgomp.c++/atomic-5.C: New test.
	* testsuite/libgomp.c++/atomic-6.C: New test.
	* testsuite/libgomp.c++/atomic-7.C: New test.
	* testsuite/libgomp.c++/atomic-8.C: New test.
	* testsuite/libgomp.c++/atomic-9.C: New test.
	* testsuite/libgomp.c++/task-8.C: New test.
	* testsuite/libgomp.c++/reduction-4.C: New test.
	* testsuite/libgomp.fortran/allocatable7.f90: New test.
	* testsuite/libgomp.fortran/allocatable8.f90: New test.
	* testsuite/libgomp.fortran/crayptr3.f90: New test.
	* testsuite/libgomp.fortran/omp_atomic3.f90: New test.
	* testsuite/libgomp.fortran/omp_atomic4.f90: New test.
	* testsuite/libgomp.fortran/pointer1.f90: New test.
	* testsuite/libgomp.fortran/pointer2.f90: New test.
	* testsuite/libgomp.fortran/task4.f90: New test.

2011-08-02  Tobias Burnus  <burnus@net-b.de>

	* libgomp.texi: Update OpenMP spec references to 3.1.
	(omp_in_final,OMP_PROC_BIND): New sections.
	(OMP_NUM_THREADS): Document that the value can be now a list.
	(GOMP_STACKSIZE,GOMP_CPU_AFFINITY): Update @ref.

From-SVN: r177194

gcc/ChangeLog

@@ -1,3 +1,60 @@
+2011-08-02  Jakub Jelinek  <jakub@redhat.com>
+
+	* c-parser.c (enum c_parser_prec): New enum, moved from within
+	c_parser_binary_expression.
+	(c_parser_binary_expression): Add PREC argument.  Stop parsing
+	if operator has lower or equal precedence than PREC.
+	(c_parser_conditional_expression, c_parser_omp_for_loop): Adjust
+	callers.
+	(c_parser_omp_atomic): Handle parsing OpenMP 3.1 atomics.
+	Adjust c_finish_omp_atomic caller.
+	(c_parser_omp_taskyield): New function.
+	(c_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
+	(c_parser_omp_clause_name): Handle final and mergeable clauses.
+	(c_parser_omp_clause_final, c_parser_omp_clause_mergeable): New
+	functions.
+	(c_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
+	and PRAGMA_OMP_CLAUSE_MERGEABLE.
+	(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
+	(c_parser_omp_clause_reduction): Handle min and max.
+	* c-typeck.c (c_finish_omp_clauses): Don't complain about
+	const qualified predetermined vars in firstprivate clause.
+	andle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
+	Handle MIN_EXPR and MAX_EXPR.
+	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_FINAL
+	and OMP_CLAUSE_MERGEABLE.
+	(dump_generic_node): Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD
+	and OMP_ATOMIC_CAPTURE_NEW.
+	* tree.c (omp_clause_num_ops): Add OMP_CLAUSE_FINAL and
+	OMP_CLAUSE_MERGEABLE.
+	(omp_clause_code_name): Likewise.
+	(walk_tree_1): Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
+	* tree.h (enum omp_clause_code): Add OMP_CLAUSE_FINAL
+	and OMP_CLAUSE_MERGEABLE.
+	(OMP_CLAUSE_FINAL_EXPR): Define.
+	* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_FINAL and
+	OMP_CLAUSE_MERGEABLE.
+	(expand_task_call): Likewise.
+	(expand_omp_atomic_load, expand_omp_atomic_store): New functions.
+	(expand_omp_atomic_fetch_op): Handle cases where old or new
+	value is needed afterwards.
+	(expand_omp_atomic): Call expand_omp_atomic_load resp.
+	expand_omp_atomic_store.
+	* gimplify.c (gimplify_omp_atomic, gimplify_expr): Handle
+	OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and OMP_ATOMIC_CAPTURE_NEW.
+	(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
+	OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
+	* tree-nested.c (convert_nonlocal_omp_clauses,
+	convert_local_omp_clauses): Likewise.
+	* tree.def (OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD,
+	OMP_ATOMIC_CAPTURE_NEW): New.
+	* gimple.h (GF_OMP_ATOMIC_NEED_VALUE): New.
+	(gimple_omp_atomic_need_value_p, gimple_omp_atomic_set_need_value):
+	New inlines.
+	* omp-builtins.def (BUILT_IN_GOMP_TASKYIELD): New builtin.
+	* doc/generic.texi: Mention OMP_CLAUSE_COLLAPSE,
+	OMP_CLAUSE_UNTIED, OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
+
 2011-08-02  Kai Tietz  <ktietz@redhat.com>
 
 	* gimple.c (canonicalize_cond_expr_cond): Handle cast from

gcc/c-family/ChangeLog

@@ -1,3 +1,20 @@
+2011-08-02  Jakub Jelinek  <jakub@redhat.com>
+
+	* c-common.h (c_finish_omp_atomic): Adjust prototype.
+	(c_finish_omp_taskyield): New prototype.
+	* c-omp.c (c_finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
+	arguments. Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and
+	OMP_ATOMIC_CAPTURE_NEW in addition to OMP_ATOMIC.  If LHS1
+	or RHS1 have side-effects, evaluate those too in the right spot,
+	if it is a decl and LHS is also a decl, error out if they
+	aren't the same.
+	(c_finish_omp_taskyield): New function.
+	* c-cppbuiltin.c (c_cpp_builtins): Change _OPENMP to 201107.
+	* c-pragma.c (omp_pragmas): Add taskyield.
+	* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_TASKYIELD.
+	(enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_FINAL and
+	PRAGMA_OMP_CLAUSE_MERGEABLE.
+
 2011-07-25  Dodji Seketeli  <dodji@redhat.com>
 
 	* c-common.h (set_underlying_type): Remove parm name from

gcc/c-family/c-common.h

@@ -1029,9 +1029,11 @@ extern tree c_finish_omp_master (location_t, tree);
 extern tree c_finish_omp_critical (location_t, tree, tree);
 extern tree c_finish_omp_ordered (location_t, tree);
 extern void c_finish_omp_barrier (location_t);
-extern tree c_finish_omp_atomic (location_t, enum tree_code, tree, tree);
+extern tree c_finish_omp_atomic (location_t, enum tree_code, enum tree_code,
+				 tree, tree, tree, tree, tree);
 extern void c_finish_omp_flush (location_t);
 extern void c_finish_omp_taskwait (location_t);
+extern void c_finish_omp_taskyield (location_t);
 extern tree c_finish_omp_for (location_t, tree, tree, tree, tree, tree, tree);
 extern void c_split_parallel_clauses (location_t, tree, tree *, tree *);
 extern enum omp_clause_default_kind c_omp_predetermined_sharing (tree);

gcc/c-family/c-cppbuiltin.c

@@ -807,7 +807,7 @@ c_cpp_builtins (cpp_reader *pfile)
     cpp_define (pfile, "__SSP__=1");
 
   if (flag_openmp)
-    cpp_define (pfile, "_OPENMP=200805");
+    cpp_define (pfile, "_OPENMP=201107");
 
   if (int128_integer_type_node != NULL_TREE)
     builtin_define_type_sizeof ("__SIZEOF_INT128__",

gcc/c-family/c-omp.c

@@ -1,7 +1,8 @@
 /* This file contains routines to construct GNU OpenMP constructs,
    called from parsing in the C and C++ front ends.
 
-   Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011
+   Free Software Foundation, Inc.
    Contributed by Richard Henderson <rth@redhat.com>,
 		  Diego Novillo <dnovillo@redhat.com>.
 
@@ -96,18 +97,39 @@ c_finish_omp_taskwait (location_t loc)
 }
 
 
-/* Complete a #pragma omp atomic construct.  The expression to be
+/* Complete a #pragma omp taskyield construct.  LOC is the location of the
-   implemented atomically is LHS code= RHS.  LOC is the location of
+   pragma.  */
-   the atomic statement.  The value returned is either error_mark_node
+
-   (if the construct was erroneous) or an OMP_ATOMIC node which should
+void
-   be added to the current statement tree with add_stmt.*/
+c_finish_omp_taskyield (location_t loc)
+{
+  tree x;
+
+  x = built_in_decls[BUILT_IN_GOMP_TASKYIELD];
+  x = build_call_expr_loc (loc, x, 0);
+  add_stmt (x);
+}
+
+
+/* Complete a #pragma omp atomic construct.  For CODE OMP_ATOMIC
+   the expression to be implemented atomically is LHS opcode= RHS. 
+   For OMP_ATOMIC_READ V = LHS, for OMP_ATOMIC_CAPTURE_{NEW,OLD} LHS
+   opcode= RHS with the new or old content of LHS returned.
+   LOC is the location of the atomic statement.  The value returned
+   is either error_mark_node (if the construct was erroneous) or an
+   OMP_ATOMIC* node which should be added to the current statement
+   tree with add_stmt.  */
 
 tree
-c_finish_omp_atomic (location_t loc, enum tree_code code, tree lhs, tree rhs)
+c_finish_omp_atomic (location_t loc, enum tree_code code,
+		     enum tree_code opcode, tree lhs, tree rhs,
+		     tree v, tree lhs1, tree rhs1)
 {
   tree x, type, addr;
 
-  if (lhs == error_mark_node || rhs == error_mark_node)
+  if (lhs == error_mark_node || rhs == error_mark_node
+      || v == error_mark_node || lhs1 == error_mark_node
+      || rhs1 == error_mark_node)
     return error_mark_node;
 
   /* ??? According to one reading of the OpenMP spec, complex type are
@@ -143,10 +165,19 @@ c_finish_omp_atomic (location_t loc, enum tree_code code, tree lhs, tree rhs)
     }
   lhs = build_indirect_ref (loc, addr, RO_NULL);
 
+  if (code == OMP_ATOMIC_READ)
+    {
+      x = build1 (OMP_ATOMIC_READ, type, addr);
+      SET_EXPR_LOCATION (x, loc);
+      return build_modify_expr (loc, v, NULL_TREE, NOP_EXPR,
+				loc, x, NULL_TREE);
+      return x;
+    }
+
   /* There are lots of warnings, errors, and conversions that need to happen
      in the course of interpreting a statement.  Use the normal mechanisms
      to do this, and then take it apart again.  */
-  x = build_modify_expr (input_location, lhs, NULL_TREE, code,
+  x = build_modify_expr (input_location, lhs, NULL_TREE, opcode,
       			 input_location, rhs, NULL_TREE);
   if (x == error_mark_node)
     return error_mark_node;
@@ -154,8 +185,68 @@ c_finish_omp_atomic (location_t loc, enum tree_code code, tree lhs, tree rhs)
   rhs = TREE_OPERAND (x, 1);
 
   /* Punt the actual generation of atomic operations to common code.  */
-  x = build2 (OMP_ATOMIC, void_type_node, addr, rhs);
+  if (code == OMP_ATOMIC)
+    type = void_type_node;
+  x = build2 (code, type, addr, rhs);
   SET_EXPR_LOCATION (x, loc);
+
+  /* Generally it is hard to prove lhs1 and lhs are the same memory
+     location, just diagnose different variables.  */
+  if (rhs1
+      && TREE_CODE (rhs1) == VAR_DECL
+      && TREE_CODE (lhs) == VAR_DECL
+      && rhs1 != lhs)
+    {
+      if (code == OMP_ATOMIC)
+	error_at (loc, "%<#pragma omp atomic update%> uses two different variables for memory");
+      else
+	error_at (loc, "%<#pragma omp atomic capture%> uses two different variables for memory");
+      return error_mark_node;
+    }
+
+  if (code != OMP_ATOMIC)
+    {
+      /* Generally it is hard to prove lhs1 and lhs are the same memory
+	 location, just diagnose different variables.  */
+      if (lhs1 && TREE_CODE (lhs1) == VAR_DECL && TREE_CODE (lhs) == VAR_DECL)
+	{
+	  if (lhs1 != lhs)
+	    {
+	      error_at (loc, "%<#pragma omp atomic capture%> uses two different variables for memory");
+	      return error_mark_node;
+	    }
+	}
+      x = build_modify_expr (loc, v, NULL_TREE, NOP_EXPR,
+			     loc, x, NULL_TREE);
+      if (rhs1 && rhs1 != lhs)
+	{
+	  tree rhs1addr = build_unary_op (loc, ADDR_EXPR, rhs1, 0);
+	  if (rhs1addr == error_mark_node)
+	    return error_mark_node;
+	  x = omit_one_operand_loc (loc, type, x, rhs1addr);
+	}
+      if (lhs1 && lhs1 != lhs)
+	{
+	  tree lhs1addr = build_unary_op (loc, ADDR_EXPR, lhs1, 0);
+	  if (lhs1addr == error_mark_node)
+	    return error_mark_node;
+	  if (code == OMP_ATOMIC_CAPTURE_OLD)
+	    x = omit_one_operand_loc (loc, type, x, lhs1addr);
+	  else
+	    {
+	      x = save_expr (x);
+	      x = omit_two_operands_loc (loc, type, x, x, lhs1addr);
+	    }
+	}
+    }
+  else if (rhs1 && rhs1 != lhs)
+    {
+      tree rhs1addr = build_unary_op (loc, ADDR_EXPR, rhs1, 0);
+      if (rhs1addr == error_mark_node)
+	return error_mark_node;
+      x = omit_one_operand_loc (loc, type, x, rhs1addr);
+    }
+
   return x;
 }
 

gcc/c-family/c-pragma.c

@@ -1196,6 +1196,7 @@ static const struct omp_pragma_def omp_pragmas[] = {
   { "single", PRAGMA_OMP_SINGLE },
   { "task", PRAGMA_OMP_TASK },
   { "taskwait", PRAGMA_OMP_TASKWAIT },
+  { "taskyield", PRAGMA_OMP_TASKYIELD },
   { "threadprivate", PRAGMA_OMP_THREADPRIVATE }
 };
 

gcc/c-family/c-pragma.h

@@ -43,6 +43,7 @@ typedef enum pragma_kind {
   PRAGMA_OMP_SINGLE,
   PRAGMA_OMP_TASK,
   PRAGMA_OMP_TASKWAIT,
+  PRAGMA_OMP_TASKYIELD,
   PRAGMA_OMP_THREADPRIVATE,
 
   PRAGMA_GCC_PCH_PREPROCESS,
@@ -70,7 +71,9 @@ typedef enum pragma_omp_clause {
   PRAGMA_OMP_CLAUSE_REDUCTION,
   PRAGMA_OMP_CLAUSE_SCHEDULE,
   PRAGMA_OMP_CLAUSE_SHARED,
-  PRAGMA_OMP_CLAUSE_UNTIED
+  PRAGMA_OMP_CLAUSE_UNTIED,
+  PRAGMA_OMP_CLAUSE_FINAL,
+  PRAGMA_OMP_CLAUSE_MERGEABLE
 } pragma_omp_clause;
 
 extern struct cpp_reader* parse_in;

gcc/c-parser.c

@@ -1090,6 +1090,23 @@ typedef enum c_dtr_syn {
   C_DTR_PARM
 } c_dtr_syn;
 
+/* The binary operation precedence levels, where 0 is a dummy lowest level
+   used for the bottom of the stack.  */
+enum c_parser_prec {
+  PREC_NONE,
+  PREC_LOGOR,
+  PREC_LOGAND,
+  PREC_BITOR,
+  PREC_BITXOR,
+  PREC_BITAND,
+  PREC_EQ,
+  PREC_REL,
+  PREC_SHIFT,
+  PREC_ADD,
+  PREC_MULT,
+  NUM_PRECS
+};
+
 static void c_parser_external_declaration (c_parser *);
 static void c_parser_asm_definition (c_parser *);
 static void c_parser_declaration_or_fndef (c_parser *, bool, bool, bool,
@@ -1138,7 +1155,8 @@ static tree c_parser_asm_clobbers (c_parser *);
 static struct c_expr c_parser_expr_no_commas (c_parser *, struct c_expr *);
 static struct c_expr c_parser_conditional_expression (c_parser *,
 						      struct c_expr *);
-static struct c_expr c_parser_binary_expression (c_parser *, struct c_expr *);
+static struct c_expr c_parser_binary_expression (c_parser *, struct c_expr *,
+						 enum c_parser_prec);
 static struct c_expr c_parser_cast_expression (c_parser *, struct c_expr *);
 static struct c_expr c_parser_unary_expression (c_parser *);
 static struct c_expr c_parser_sizeof_expression (c_parser *);
@@ -1159,6 +1177,7 @@ static void c_parser_omp_threadprivate (c_parser *);
 static void c_parser_omp_barrier (c_parser *);
 static void c_parser_omp_flush (c_parser *);
 static void c_parser_omp_taskwait (c_parser *);
+static void c_parser_omp_taskyield (c_parser *);
 
 enum pragma_context { pragma_external, pragma_stmt, pragma_compound };
 static bool c_parser_pragma (c_parser *, enum pragma_context);
@@ -5308,7 +5327,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after)
 
   gcc_assert (!after || c_dialect_objc ());
 
-  cond = c_parser_binary_expression (parser, after);
+  cond = c_parser_binary_expression (parser, after, PREC_NONE);
 
   if (c_parser_next_token_is_not (parser, CPP_QUERY))
     return cond;
@@ -5393,7 +5412,8 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after)
 /* Parse a binary expression; that is, a logical-OR-expression (C90
    6.3.5-6.3.14, C99 6.5.5-6.5.14).  If AFTER is not NULL then it is
    an Objective-C message expression which is the primary-expression
-   starting the expression as an initializer.
+   starting the expression as an initializer.  PREC is the starting
+   precedence, usually PREC_NONE.
 
    multiplicative-expression:
      cast-expression
@@ -5445,7 +5465,8 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after)
 */
 
 static struct c_expr
-c_parser_binary_expression (c_parser *parser, struct c_expr *after)
+c_parser_binary_expression (c_parser *parser, struct c_expr *after,
+			    enum c_parser_prec prec)
 {
   /* A binary expression is parsed using operator-precedence parsing,
      with the operands being cast expressions.  All the binary
@@ -5468,28 +5489,12 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after)
      expressions, we also need to adjust c_inhibit_evaluation_warnings
      as appropriate when the operators are pushed and popped.  */
 
-  /* The precedence levels, where 0 is a dummy lowest level used for
-     the bottom of the stack.  */
-  enum prec {
-    PREC_NONE,
-    PREC_LOGOR,
-    PREC_LOGAND,
-    PREC_BITOR,
-    PREC_BITXOR,
-    PREC_BITAND,
-    PREC_EQ,
-    PREC_REL,
-    PREC_SHIFT,
-    PREC_ADD,
-    PREC_MULT,
-    NUM_PRECS
-  };
   struct {
     /* The expression at this stack level.  */
     struct c_expr expr;
     /* The precedence of the operator on its left, PREC_NONE at the
        bottom of the stack.  */
-    enum prec prec;
+    enum c_parser_prec prec;
     /* The operation on its left.  */
     enum tree_code op;
     /* The source location of this operation.  */
@@ -5528,11 +5533,11 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after)
   gcc_assert (!after || c_dialect_objc ());
   stack[0].loc = c_parser_peek_token (parser)->location;
   stack[0].expr = c_parser_cast_expression (parser, after);
-  stack[0].prec = PREC_NONE;
+  stack[0].prec = prec;
   sp = 0;
   while (true)
     {
-      enum prec oprec;
+      enum c_parser_prec oprec;
       enum tree_code ocode;
       if (parser->error)
 	goto out;
@@ -5616,9 +5621,13 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after)
 	  goto out;
 	}
       binary_loc = c_parser_peek_token (parser)->location;
-      c_parser_consume_token (parser);
       while (oprec <= stack[sp].prec)
-	POP;
+	{
+	  if (sp == 0)
+	    goto out;
+	  POP;
+	}
+      c_parser_consume_token (parser);
       switch (ocode)
 	{
 	case TRUTH_ANDIF_EXPR:
@@ -8243,6 +8252,17 @@ c_parser_pragma (c_parser *parser, enum pragma_context context)
       c_parser_omp_taskwait (parser);
       return false;
 
+    case PRAGMA_OMP_TASKYIELD:
+      if (context != pragma_compound)
+	{
+	  if (context == pragma_stmt)
+	    c_parser_error (parser, "%<#pragma omp taskyield%> may only be "
+			    "used in compound statements");
+	  goto bad_stmt;
+	}
+      c_parser_omp_taskyield (parser);
+      return false;
+
     case PRAGMA_OMP_THREADPRIVATE:
       c_parser_omp_threadprivate (parser);
       return false;
@@ -8358,13 +8378,19 @@ c_parser_omp_clause_name (c_parser *parser)
 	    result = PRAGMA_OMP_CLAUSE_COPYPRIVATE;
 	  break;
 	case 'f':
-	  if (!strcmp ("firstprivate", p))
+	  if (!strcmp ("final", p))
+	    result = PRAGMA_OMP_CLAUSE_FINAL;
+	  else if (!strcmp ("firstprivate", p))
 	    result = PRAGMA_OMP_CLAUSE_FIRSTPRIVATE;
 	  break;
 	case 'l':
 	  if (!strcmp ("lastprivate", p))
 	    result = PRAGMA_OMP_CLAUSE_LASTPRIVATE;
 	  break;
+	case 'm':
+	  if (!strcmp ("mergeable", p))
+	    result = PRAGMA_OMP_CLAUSE_MERGEABLE;
+	  break;
 	case 'n':
 	  if (!strcmp ("nowait", p))
 	    result = PRAGMA_OMP_CLAUSE_NOWAIT;
@@ -8606,6 +8632,31 @@ c_parser_omp_clause_firstprivate (c_parser *parser, tree list)
   return c_parser_omp_var_list_parens (parser, OMP_CLAUSE_FIRSTPRIVATE, list);
 }
 
+/* OpenMP 3.1:
+   final ( expression ) */
+
+static tree
+c_parser_omp_clause_final (c_parser *parser, tree list)
+{
+  location_t loc = c_parser_peek_token (parser)->location;
+  if (c_parser_next_token_is (parser, CPP_OPEN_PAREN))
+    {
+      tree t = c_parser_paren_condition (parser);
+      tree c;
+
+      check_no_duplicate_clause (list, OMP_CLAUSE_FINAL, "final");
+
+      c = build_omp_clause (loc, OMP_CLAUSE_FINAL);
+      OMP_CLAUSE_FINAL_EXPR (c) = t;
+      OMP_CLAUSE_CHAIN (c) = list;
+      list = c;
+    }
+  else
+    c_parser_error (parser, "expected %<(%>");
+
+  return list;
+}
+
 /* OpenMP 2.5:
    if ( expression ) */
 
@@ -8640,6 +8691,24 @@ c_parser_omp_clause_lastprivate (c_parser *parser, tree list)
   return c_parser_omp_var_list_parens (parser, OMP_CLAUSE_LASTPRIVATE, list);
 }
 
+/* OpenMP 3.1:
+   mergeable */
+
+static tree
+c_parser_omp_clause_mergeable (c_parser *parser ATTRIBUTE_UNUSED, tree list)
+{
+  tree c;
+
+  /* FIXME: Should we allow duplicates?  */
+  check_no_duplicate_clause (list, OMP_CLAUSE_MERGEABLE, "mergeable");
+
+  c = build_omp_clause (c_parser_peek_token (parser)->location,
+			OMP_CLAUSE_MERGEABLE);
+  OMP_CLAUSE_CHAIN (c) = list;
+
+  return c;
+}
+
 /* OpenMP 2.5:
    nowait */
 
@@ -8730,7 +8799,12 @@ c_parser_omp_clause_private (c_parser *parser, tree list)
    reduction ( reduction-operator : variable-list )
 
    reduction-operator:
-     One of: + * - & ^ | && || */
+     One of: + * - & ^ | && ||
+     
+   OpenMP 3.1:
+   
+   reduction-operator:
+     One of: + * - & ^ | && || max min  */
 
 static tree
 c_parser_omp_clause_reduction (c_parser *parser, tree list)
@@ -8766,10 +8840,26 @@ c_parser_omp_clause_reduction (c_parser *parser, tree list)
 	case CPP_OR_OR:
 	  code = TRUTH_ORIF_EXPR;
 	  break;
+        case CPP_NAME:
+	  {
+	    const char *p
+	      = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+	    if (strcmp (p, "min") == 0)
+	      {
+		code = MIN_EXPR;
+		break;
+	      }
+	    if (strcmp (p, "max") == 0)
+	      {
+		code = MAX_EXPR;
+		break;
+	      }
+	  }
+	  /* FALLTHRU */
 	default:
 	  c_parser_error (parser,
 			  "expected %<+%>, %<*%>, %<-%>, %<&%>, "
-			  "%<^%>, %<|%>, %<&&%>, or %<||%>");
+			  "%<^%>, %<|%>, %<&&%>, %<||%>, %<min%> or %<max%>");
 	  c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, 0);
 	  return list;
 	}
@@ -8957,6 +9047,10 @@ c_parser_omp_all_clauses (c_parser *parser, unsigned int mask,
 	  clauses = c_parser_omp_clause_firstprivate (parser, clauses);
 	  c_name = "firstprivate";
 	  break;
+	case PRAGMA_OMP_CLAUSE_FINAL:
+	  clauses = c_parser_omp_clause_final (parser, clauses);
+	  c_name = "final";
+	  break;
 	case PRAGMA_OMP_CLAUSE_IF:
 	  clauses = c_parser_omp_clause_if (parser, clauses);
 	  c_name = "if";
@@ -8965,6 +9059,10 @@ c_parser_omp_all_clauses (c_parser *parser, unsigned int mask,
 	  clauses = c_parser_omp_clause_lastprivate (parser, clauses);
 	  c_name = "lastprivate";
 	  break;
+	case PRAGMA_OMP_CLAUSE_MERGEABLE:
+	  clauses = c_parser_omp_clause_mergeable (parser, clauses);
+	  c_name = "mergeable";
+	  break;
 	case PRAGMA_OMP_CLAUSE_NOWAIT:
 	  clauses = c_parser_omp_clause_nowait (parser, clauses);
 	  c_name = "nowait";
@@ -9044,38 +9142,158 @@ c_parser_omp_structured_block (c_parser *parser)
 
   where x is an lvalue expression with scalar type.
 
+   OpenMP 3.1:
+   # pragma omp atomic new-line
+     update-stmt
+
+   # pragma omp atomic read new-line
+     read-stmt
+
+   # pragma omp atomic write new-line
+     write-stmt
+
+   # pragma omp atomic update new-line
+     update-stmt
+
+   # pragma omp atomic capture new-line
+     capture-stmt
+
+   # pragma omp atomic capture new-line
+     capture-block
+
+   read-stmt:
+     v = x
+   write-stmt:
+     x = expr
+   update-stmt:
+     expression-stmt | x = x binop expr
+   capture-stmt:
+     v = x binop= expr | v = x++ | v = ++x | v = x-- | v = --x
+   capture-block:
+     { v = x; update-stmt; } | { update-stmt; v = x; }
+
+  where x and v are lvalue expressions with scalar type.
+
   LOC is the location of the #pragma token.  */
 
 static void
 c_parser_omp_atomic (location_t loc, c_parser *parser)
 {
-  tree lhs, rhs;
+  tree lhs = NULL_TREE, rhs = NULL_TREE, v = NULL_TREE;
-  tree stmt;
+  tree lhs1 = NULL_TREE, rhs1 = NULL_TREE;
-  enum tree_code code;
+  tree stmt, orig_lhs;
+  enum tree_code code = OMP_ATOMIC, opcode = NOP_EXPR;
   struct c_expr rhs_expr;
+  bool structured_block = false;
 
+  if (c_parser_next_token_is (parser, CPP_NAME))
+    {
+      const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+
+      if (!strcmp (p, "read"))
+	code = OMP_ATOMIC_READ;
+      else if (!strcmp (p, "write"))
+	code = NOP_EXPR;
+      else if (!strcmp (p, "update"))
+	code = OMP_ATOMIC;
+      else if (!strcmp (p, "capture"))
+	code = OMP_ATOMIC_CAPTURE_NEW;
+      else
+	p = NULL;
+      if (p)
+	c_parser_consume_token (parser);
+    }
   c_parser_skip_to_pragma_eol (parser);
 
+  switch (code)
+    {
+    case OMP_ATOMIC_READ:
+    case NOP_EXPR: /* atomic write */
+      v = c_parser_unary_expression (parser).value;
+      v = c_fully_fold (v, false, NULL);
+      if (v == error_mark_node)
+	goto saw_error;
+      loc = c_parser_peek_token (parser)->location;
+      if (!c_parser_require (parser, CPP_EQ, "expected %<=%>"))
+	goto saw_error;
+      if (code == NOP_EXPR)
+	lhs = c_parser_expression (parser).value;
+      else
+	lhs = c_parser_unary_expression (parser).value;
+      lhs = c_fully_fold (lhs, false, NULL);
+      if (lhs == error_mark_node)
+	goto saw_error;
+      if (code == NOP_EXPR)
+	{
+	  /* atomic write is represented by OMP_ATOMIC with NOP_EXPR
+	     opcode.  */
+	  code = OMP_ATOMIC;
+	  rhs = lhs;
+	  lhs = v;
+	  v = NULL_TREE;
+	}
+      goto done;
+    case OMP_ATOMIC_CAPTURE_NEW:
+      if (c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+	{
+	  c_parser_consume_token (parser);
+	  structured_block = true;
+	}
+      else
+	{
+	  v = c_parser_unary_expression (parser).value;
+	  v = c_fully_fold (v, false, NULL);
+	  if (v == error_mark_node)
+	    goto saw_error;
+	  if (!c_parser_require (parser, CPP_EQ, "expected %<=%>"))
+	    goto saw_error;
+	}
+      break;
+    default:
+      break;
+    }
+
+  /* For structured_block case we don't know yet whether
+     old or new x should be captured.  */
+restart:
   lhs = c_parser_unary_expression (parser).value;
   lhs = c_fully_fold (lhs, false, NULL);
+  orig_lhs = lhs;
   switch (TREE_CODE (lhs))
     {
     case ERROR_MARK:
     saw_error:
       c_parser_skip_to_end_of_block_or_statement (parser);
+      if (structured_block)
+	{
+	  if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
+	    c_parser_consume_token (parser);
+	  else if (code == OMP_ATOMIC_CAPTURE_NEW)
+	    {
+	      c_parser_skip_to_end_of_block_or_statement (parser);
+	      if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
+		c_parser_consume_token (parser);
+	    }
+	}
       return;
 
-    case PREINCREMENT_EXPR:
     case POSTINCREMENT_EXPR:
+      if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
+	code = OMP_ATOMIC_CAPTURE_OLD;
+      /* FALLTHROUGH */
+    case PREINCREMENT_EXPR:
       lhs = TREE_OPERAND (lhs, 0);
-      code = PLUS_EXPR;
+      opcode = PLUS_EXPR;
       rhs = integer_one_node;
       break;
 
-    case PREDECREMENT_EXPR:
     case POSTDECREMENT_EXPR:
+      if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
+	code = OMP_ATOMIC_CAPTURE_OLD;
+      /* FALLTHROUGH */
+    case PREDECREMENT_EXPR:
       lhs = TREE_OPERAND (lhs, 0);
-      code = MINUS_EXPR;
+      opcode = MINUS_EXPR;
       rhs = integer_one_node;
       break;
 
@@ -9100,7 +9318,11 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
 	      /* This is pre or post increment.  */
 	      rhs = TREE_OPERAND (lhs, 1);
 	      lhs = TREE_OPERAND (lhs, 0);
-	      code = NOP_EXPR;
+	      opcode = NOP_EXPR;
+	      if (code == OMP_ATOMIC_CAPTURE_NEW
+		  && !structured_block
+		  && TREE_CODE (orig_lhs) == COMPOUND_EXPR)
+		code = OMP_ATOMIC_CAPTURE_OLD;
 	      break;
 	    }
 	  if (TREE_CODE (TREE_OPERAND (lhs, 1)) == TRUTH_NOT_EXPR
@@ -9110,7 +9332,11 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
 	      /* This is pre or post decrement.  */
 	      rhs = TREE_OPERAND (lhs, 1);
 	      lhs = TREE_OPERAND (lhs, 0);
-	      code = NOP_EXPR;
+	      opcode = NOP_EXPR;
+	      if (code == OMP_ATOMIC_CAPTURE_NEW
+		  && !structured_block
+		  && TREE_CODE (orig_lhs) == COMPOUND_EXPR)
+		code = OMP_ATOMIC_CAPTURE_OLD;
 	      break;
 	    }
 	}
@@ -9119,32 +9345,114 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
       switch (c_parser_peek_token (parser)->type)
 	{
 	case CPP_MULT_EQ:
-	  code = MULT_EXPR;
+	  opcode = MULT_EXPR;
 	  break;
 	case CPP_DIV_EQ:
-	  code = TRUNC_DIV_EXPR;
+	  opcode = TRUNC_DIV_EXPR;
 	  break;
 	case CPP_PLUS_EQ:
-	  code = PLUS_EXPR;
+	  opcode = PLUS_EXPR;
 	  break;
 	case CPP_MINUS_EQ:
-	  code = MINUS_EXPR;
+	  opcode = MINUS_EXPR;
 	  break;
 	case CPP_LSHIFT_EQ:
-	  code = LSHIFT_EXPR;
+	  opcode = LSHIFT_EXPR;
 	  break;
 	case CPP_RSHIFT_EQ:
-	  code = RSHIFT_EXPR;
+	  opcode = RSHIFT_EXPR;
 	  break;
 	case CPP_AND_EQ:
-	  code = BIT_AND_EXPR;
+	  opcode = BIT_AND_EXPR;
 	  break;
 	case CPP_OR_EQ:
-	  code = BIT_IOR_EXPR;
+	  opcode = BIT_IOR_EXPR;
 	  break;
 	case CPP_XOR_EQ:
-	  code = BIT_XOR_EXPR;
+	  opcode = BIT_XOR_EXPR;
 	  break;
+	case CPP_EQ:
+	  if (structured_block || code == OMP_ATOMIC)
+	    {
+	      location_t aloc = c_parser_peek_token (parser)->location;
+	      location_t rhs_loc;
+	      enum c_parser_prec oprec = PREC_NONE;
+
+	      c_parser_consume_token (parser);
+	      rhs1 = c_parser_unary_expression (parser).value;
+	      rhs1 = c_fully_fold (rhs1, false, NULL);
+	      if (rhs1 == error_mark_node)
+		goto saw_error;
+	      switch (c_parser_peek_token (parser)->type)
+		{
+		case CPP_SEMICOLON:
+		  if (code == OMP_ATOMIC_CAPTURE_NEW)
+		    {
+		      code = OMP_ATOMIC_CAPTURE_OLD;
+		      v = lhs;
+		      lhs = NULL_TREE;
+		      lhs1 = rhs1;
+		      rhs1 = NULL_TREE;
+		      c_parser_consume_token (parser);
+		      goto restart;
+		    }
+		  c_parser_error (parser,
+				  "invalid form of %<#pragma omp atomic%>");
+		  goto saw_error;
+		case CPP_MULT:
+		  opcode = MULT_EXPR;
+		  oprec = PREC_MULT;
+		  break;
+		case CPP_DIV:
+		  opcode = TRUNC_DIV_EXPR;
+		  oprec = PREC_MULT;
+		  break;
+		case CPP_PLUS:
+		  opcode = PLUS_EXPR;
+		  oprec = PREC_ADD;
+		  break;
+		case CPP_MINUS:
+		  opcode = MINUS_EXPR;
+		  oprec = PREC_ADD;
+		  break;
+		case CPP_LSHIFT:
+		  opcode = LSHIFT_EXPR;
+		  oprec = PREC_SHIFT;
+		  break;
+		case CPP_RSHIFT:
+		  opcode = RSHIFT_EXPR;
+		  oprec = PREC_SHIFT;
+		  break;
+		case CPP_AND:
+		  opcode = BIT_AND_EXPR;
+		  oprec = PREC_BITAND;
+		  break;
+		case CPP_OR:
+		  opcode = BIT_IOR_EXPR;
+		  oprec = PREC_BITOR;
+		  break;
+		case CPP_XOR:
+		  opcode = BIT_XOR_EXPR;
+		  oprec = PREC_BITXOR;
+		  break;
+		default:
+		  c_parser_error (parser,
+				  "invalid operator for %<#pragma omp atomic%>");
+		  goto saw_error;
+		}
+	      loc = aloc;
+	      c_parser_consume_token (parser);
+	      rhs_loc = c_parser_peek_token (parser)->location;
+	      if (commutative_tree_code (opcode))
+		oprec = (enum c_parser_prec) (oprec - 1);
+	      rhs_expr = c_parser_binary_expression (parser, NULL, oprec);
+	      rhs_expr = default_function_array_read_conversion (rhs_loc,
+								 rhs_expr);
+	      rhs = rhs_expr.value;
+	      rhs = c_fully_fold (rhs, false, NULL);
+	      goto stmt_done; 
+	    }
+	  /* FALLTHROUGH */
 	default:
 	  c_parser_error (parser,
 			  "invalid operator for %<#pragma omp atomic%>");
@@ -9164,10 +9472,34 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
       rhs = c_fully_fold (rhs, false, NULL);
       break;
     }
-  stmt = c_finish_omp_atomic (loc, code, lhs, rhs);
+stmt_done:
+  if (structured_block && code == OMP_ATOMIC_CAPTURE_NEW)
+    {
+      if (!c_parser_require (parser, CPP_SEMICOLON, "expected %<;%>"))
+	goto saw_error;
+      v = c_parser_unary_expression (parser).value;
+      v = c_fully_fold (v, false, NULL);
+      if (v == error_mark_node)
+	goto saw_error;
+      if (!c_parser_require (parser, CPP_EQ, "expected %<=%>"))
+	goto saw_error;
+      lhs1 = c_parser_unary_expression (parser).value;
+      lhs1 = c_fully_fold (lhs1, false, NULL);
+      if (lhs1 == error_mark_node)
+	goto saw_error;
+    }
+  if (structured_block)
+    {
+      c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+      c_parser_require (parser, CPP_CLOSE_BRACE, "expected %<}%>");
+    }
+done:
+  stmt = c_finish_omp_atomic (loc, code, opcode, lhs, rhs, v, lhs1, rhs1);
   if (stmt != error_mark_node)
     add_stmt (stmt);
-  c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+
+  if (!structured_block)
+    c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
 }
 
 
@@ -9330,7 +9662,8 @@ c_parser_omp_for_loop (location_t loc,
       if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
 	{
 	  location_t cond_loc = c_parser_peek_token (parser)->location;
-	  struct c_expr cond_expr = c_parser_binary_expression (parser, NULL);
+	  struct c_expr cond_expr = c_parser_binary_expression (parser, NULL,
+								PREC_NONE);
 
 	  cond = cond_expr.value;
 	  cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
@@ -9827,7 +10160,9 @@ c_parser_omp_single (location_t loc, c_parser *parser)
 	| (1u << PRAGMA_OMP_CLAUSE_DEFAULT)		\
 	| (1u << PRAGMA_OMP_CLAUSE_PRIVATE)		\
 	| (1u << PRAGMA_OMP_CLAUSE_FIRSTPRIVATE)	\
-	| (1u << PRAGMA_OMP_CLAUSE_SHARED))
+	| (1u << PRAGMA_OMP_CLAUSE_SHARED)		\
+	| (1u << PRAGMA_OMP_CLAUSE_FINAL)		\
+	| (1u << PRAGMA_OMP_CLAUSE_MERGEABLE))
 
 static tree
 c_parser_omp_task (location_t loc, c_parser *parser)
@@ -9856,6 +10191,20 @@ c_parser_omp_taskwait (c_parser *parser)
   c_finish_omp_taskwait (loc);
 }
 
+/* OpenMP 3.1:
+   # pragma omp taskyield new-line
+*/
+
+static void
+c_parser_omp_taskyield (c_parser *parser)
+{
+  location_t loc = c_parser_peek_token (parser)->location;
+  c_parser_consume_pragma (parser);
+  c_parser_skip_to_pragma_eol (parser);
+
+  c_finish_omp_taskyield (loc);
+}
+
 /* Main entry point to parsing most OpenMP pragmas.  */
 
 static void

gcc/c-typeck.c

@@ -10451,6 +10451,8 @@ c_finish_omp_clauses (tree clauses)
 		case PLUS_EXPR:
 		case MULT_EXPR:
 		case MINUS_EXPR:
+		case MIN_EXPR:
+		case MAX_EXPR:
 		  break;
 		case BIT_AND_EXPR:
 		  r_name = "&";
@@ -10567,6 +10569,8 @@ c_finish_omp_clauses (tree clauses)
 	case OMP_CLAUSE_DEFAULT:
 	case OMP_CLAUSE_UNTIED:
 	case OMP_CLAUSE_COLLAPSE:
+	case OMP_CLAUSE_FINAL:
+	case OMP_CLAUSE_MERGEABLE:
 	  pc = &OMP_CLAUSE_CHAIN (c);
 	  continue;
 
@@ -10596,6 +10600,10 @@ c_finish_omp_clauses (tree clauses)
 		case OMP_CLAUSE_DEFAULT_UNSPECIFIED:
 		  break;
 		case OMP_CLAUSE_DEFAULT_SHARED:
+		  /* const vars may be specified in firstprivate clause.  */
+		  if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
+		      && TREE_READONLY (t))
+		    break;
 		  share_name = "shared";
 		  break;
 		case OMP_CLAUSE_DEFAULT_PRIVATE:

gcc/cp/ChangeLog

@@ -1,3 +1,33 @@
+2011-08-02  Jakub Jelinek  <jakub@redhat.com>
+
+	* cp-tree.h (finish_omp_atomic): Adjust prototype.
+	(cxx_omp_const_qual_no_mutable): New prototype.
+	(finish_omp_taskyield): New prototype.
+	* parser.c (cp_parser_omp_atomic): (cp_parser_omp_atomic): Handle
+	parsing OpenMP 3.1 atomics.  Adjust finish_omp_atomic caller.
+	(cp_parser_omp_clause_name): Handle final and mergeable clauses.
+	(cp_parser_omp_clause_final, cp_parser_omp_clause_mergeable): New
+	functions.
+	(cp_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
+	and PRAGMA_OMP_CLAUSE_MERGEABLE.
+	(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
+	(cp_parser_omp_taskyield): New function.
+	(cp_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
+	(cp_parser_omp_clause_reduction): Handle min and max.
+	* pt.c (tsubst_expr) <case OMP_ATOMIC>: Handle OpenMP 3.1 atomics.
+	(tsubst_omp_clauses): Handle OMP_CLAUSE_FINAL and
+	OMP_CLAUSE_MERGEABLE.
+	* semantics.c (finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
+	arguments.  Handle OpenMP 3.1 atomics.  Adjust c_finish_omp_atomic
+	caller.
+	(finish_omp_clauses): Don't complain about const qualified
+	predetermined vars and static data members in firstprivate clause.
+	Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE. Handle MIN_EXPR
+	and MAX_EXPR.
+	(finish_omp_taskyield): New function.
+	* cp-gimplify.c (cxx_omp_const_qual_no_mutable): New function.
+	(cxx_omp_predetermined_sharing): Use it.
+
 2011-08-02  Jason Merrill  <jason@redhat.com>
 
 	* call.c (build_call_a): Also check at_function_scope_p.

gcc/cp/cp-gimplify.c

@@ -1365,26 +1365,15 @@ cxx_omp_privatize_by_reference (const_tree decl)
   return is_invisiref_parm (decl);
 }
 
-/* True if OpenMP sharing attribute of DECL is predetermined.  */
+/* Return true if DECL is const qualified var having no mutable member.  */
-
+bool
-enum omp_clause_default_kind
+cxx_omp_const_qual_no_mutable (tree decl)
-cxx_omp_predetermined_sharing (tree decl)
 {
-  tree type;
+  tree type = TREE_TYPE (decl);
-
-  /* Static data members are predetermined as shared.  */
-  if (TREE_STATIC (decl))
-    {
-      tree ctx = CP_DECL_CONTEXT (decl);
-      if (TYPE_P (ctx) && MAYBE_CLASS_TYPE_P (ctx))
-	return OMP_CLAUSE_DEFAULT_SHARED;
-    }
-
-  type = TREE_TYPE (decl);
   if (TREE_CODE (type) == REFERENCE_TYPE)
     {
       if (!is_invisiref_parm (decl))
-	return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
+	return false;
       type = TREE_TYPE (type);
 
       if (TREE_CODE (decl) == RESULT_DECL && DECL_NAME (decl))
@@ -1408,11 +1397,32 @@ cxx_omp_predetermined_sharing (tree decl)
     }
 
   if (type == error_mark_node)
-    return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
+    return false;
 
   /* Variables with const-qualified type having no mutable member
      are predetermined shared.  */
   if (TYPE_READONLY (type) && !cp_has_mutable_p (type))
+    return true;
+
+  return false;
+}
+
+/* True if OpenMP sharing attribute of DECL is predetermined.  */
+
+enum omp_clause_default_kind
+cxx_omp_predetermined_sharing (tree decl)
+{
+  /* Static data members are predetermined shared.  */
+  if (TREE_STATIC (decl))
+    {
+      tree ctx = CP_DECL_CONTEXT (decl);
+      if (TYPE_P (ctx) && MAYBE_CLASS_TYPE_P (ctx))
+	return OMP_CLAUSE_DEFAULT_SHARED;
+    }
+
+  /* Const qualified vars having no mutable member are predetermined
+     shared.  */
+  if (cxx_omp_const_qual_no_mutable (decl))
     return OMP_CLAUSE_DEFAULT_SHARED;
 
   return OMP_CLAUSE_DEFAULT_UNSPECIFIED;

gcc/cp/cp-tree.h

@@ -5454,10 +5454,12 @@ extern tree begin_omp_task			(void);
 extern tree finish_omp_task			(tree, tree);
 extern tree finish_omp_for			(location_t, tree, tree,
 						 tree, tree, tree, tree, tree);
-extern void finish_omp_atomic			(enum tree_code, tree, tree);
+extern void finish_omp_atomic			(enum tree_code, enum tree_code,
+						 tree, tree, tree, tree, tree);
 extern void finish_omp_barrier			(void);
 extern void finish_omp_flush			(void);
 extern void finish_omp_taskwait			(void);
+extern void finish_omp_taskyield		(void);
 extern bool cxx_omp_create_clause_info		(tree, tree, bool, bool, bool);
 extern tree baselink_for_fns                    (tree);
 extern void finish_static_assert                (tree, tree, location_t,
@@ -5765,6 +5767,7 @@ extern void init_shadowed_var_for_decl		(void);
 extern int cp_gimplify_expr			(tree *, gimple_seq *,
 						 gimple_seq *);
 extern void cp_genericize			(tree);
+extern bool cxx_omp_const_qual_no_mutable	(tree);
 extern enum omp_clause_default_kind cxx_omp_predetermined_sharing (tree);
 extern tree cxx_omp_clause_default_ctor		(tree, tree, tree);
 extern tree cxx_omp_clause_copy_ctor		(tree, tree, tree);

gcc/cp/parser.c

@@ -23600,13 +23600,19 @@ cp_parser_omp_clause_name (cp_parser *parser)
 	    result = PRAGMA_OMP_CLAUSE_COPYPRIVATE;
 	  break;
 	case 'f':
-	  if (!strcmp ("firstprivate", p))
+	  if (!strcmp ("final", p))
+	    result = PRAGMA_OMP_CLAUSE_FINAL;
+	  else if (!strcmp ("firstprivate", p))
 	    result = PRAGMA_OMP_CLAUSE_FIRSTPRIVATE;
 	  break;
 	case 'l':
 	  if (!strcmp ("lastprivate", p))
 	    result = PRAGMA_OMP_CLAUSE_LASTPRIVATE;
 	  break;
+	case 'm':
+	  if (!strcmp ("mergeable", p))
+	    result = PRAGMA_OMP_CLAUSE_MERGEABLE;
+	  break;
 	case 'n':
 	  if (!strcmp ("nowait", p))
 	    result = PRAGMA_OMP_CLAUSE_NOWAIT;
@@ -23836,6 +23842,34 @@ cp_parser_omp_clause_default (cp_parser *parser, tree list, location_t location)
   return c;
 }
 
+/* OpenMP 3.1:
+   final ( expression ) */
+
+static tree
+cp_parser_omp_clause_final (cp_parser *parser, tree list, location_t location)
+{
+  tree t, c;
+
+  if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
+    return list;
+
+  t = cp_parser_condition (parser);
+
+  if (t == error_mark_node
+      || !cp_parser_require (parser, CPP_CLOSE_PAREN, RT_CLOSE_PAREN))
+    cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
+					   /*or_comma=*/false,
+					   /*consume_paren=*/true);
+
+  check_no_duplicate_clause (list, OMP_CLAUSE_FINAL, "final", location);
+
+  c = build_omp_clause (location, OMP_CLAUSE_FINAL);
+  OMP_CLAUSE_FINAL_EXPR (c) = t;
+  OMP_CLAUSE_CHAIN (c) = list;
+
+  return c;
+}
+
 /* OpenMP 2.5:
    if ( expression ) */
 
@@ -23864,6 +23898,23 @@ cp_parser_omp_clause_if (cp_parser *parser, tree list, location_t location)
   return c;
 }
 
+/* OpenMP 3.1:
+   mergeable */
+
+static tree
+cp_parser_omp_clause_mergeable (cp_parser *parser ATTRIBUTE_UNUSED,
+				tree list, location_t location)
+{
+  tree c;
+
+  check_no_duplicate_clause (list, OMP_CLAUSE_MERGEABLE, "mergeable",
+			     location);
+
+  c = build_omp_clause (location, OMP_CLAUSE_MERGEABLE);
+  OMP_CLAUSE_CHAIN (c) = list;
+  return c;
+}
+
 /* OpenMP 2.5:
    nowait */
 
@@ -23931,7 +23982,12 @@ cp_parser_omp_clause_ordered (cp_parser *parser ATTRIBUTE_UNUSED,
    reduction ( reduction-operator : variable-list )
 
    reduction-operator:
-     One of: + * - & ^ | && || */
+     One of: + * - & ^ | && ||
+
+   OpenMP 3.1:
+
+   reduction-operator:
+     One of: + * - & ^ | && || min max  */
 
 static tree
 cp_parser_omp_clause_reduction (cp_parser *parser, tree list)
@@ -23968,9 +24024,26 @@ cp_parser_omp_clause_reduction (cp_parser *parser, tree list)
     case CPP_OR_OR:
       code = TRUTH_ORIF_EXPR;
       break;
+    case CPP_NAME:
+      {
+	tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+	const char *p = IDENTIFIER_POINTER (id);
+
+	if (strcmp (p, "min") == 0)
+	  {
+	    code = MIN_EXPR;
+	    break;
+	  }
+	if (strcmp (p, "max") == 0)
+	  {
+	    code = MAX_EXPR;
+	    break;
+	  }
+      }
+      /* FALLTHROUGH */
     default:
       cp_parser_error (parser, "expected %<+%>, %<*%>, %<-%>, %<&%>, %<^%>, "
-			       "%<|%>, %<&&%>, or %<||%>");
+			       "%<|%>, %<&&%>, %<||%>, %<min%> or %<max%>");
     resync_fail:
       cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
 					     /*or_comma=*/false,
@@ -24143,6 +24216,10 @@ cp_parser_omp_all_clauses (cp_parser *parser, unsigned int mask,
 						  token->location);
 	  c_name = "default";
 	  break;
+	case PRAGMA_OMP_CLAUSE_FINAL:
+	  clauses = cp_parser_omp_clause_final (parser, clauses, token->location);
+	  c_name = "final";
+	  break;
 	case PRAGMA_OMP_CLAUSE_FIRSTPRIVATE:
 	  clauses = cp_parser_omp_var_list (parser, OMP_CLAUSE_FIRSTPRIVATE,
 					    clauses);
@@ -24157,6 +24234,11 @@ cp_parser_omp_all_clauses (cp_parser *parser, unsigned int mask,
 					    clauses);
 	  c_name = "lastprivate";
 	  break;
+	case PRAGMA_OMP_CLAUSE_MERGEABLE:
+	  clauses = cp_parser_omp_clause_mergeable (parser, clauses,
+						    token->location);
+	  c_name = "mergeable";
+	  break;
 	case PRAGMA_OMP_CLAUSE_NOWAIT:
 	  clauses = cp_parser_omp_clause_nowait (parser, clauses, token->location);
 	  c_name = "nowait";
@@ -24267,34 +24349,140 @@ cp_parser_omp_structured_block (cp_parser *parser)
    binop:
      +, *, -, /, &, ^, |, <<, >>
 
-  where x is an lvalue expression with scalar type.  */
+  where x is an lvalue expression with scalar type.
+
+   OpenMP 3.1:
+   # pragma omp atomic new-line
+     update-stmt
+
+   # pragma omp atomic read new-line
+     read-stmt
+
+   # pragma omp atomic write new-line
+     write-stmt
+
+   # pragma omp atomic update new-line
+     update-stmt
+
+   # pragma omp atomic capture new-line
+     capture-stmt
+
+   # pragma omp atomic capture new-line
+     capture-block
+
+   read-stmt:
+     v = x
+   write-stmt:
+     x = expr
+   update-stmt:
+     expression-stmt | x = x binop expr
+   capture-stmt:
+     v = x binop= expr | v = x++ | v = ++x | v = x-- | v = --x
+   capture-block:
+     { v = x; update-stmt; } | { update-stmt; v = x; }
+
+  where x and v are lvalue expressions with scalar type.  */
 
 static void
 cp_parser_omp_atomic (cp_parser *parser, cp_token *pragma_tok)
 {
-  tree lhs, rhs;
+  tree lhs = NULL_TREE, rhs = NULL_TREE, v = NULL_TREE, lhs1 = NULL_TREE;
-  enum tree_code code;
+  tree rhs1 = NULL_TREE, orig_lhs;
+  enum tree_code code = OMP_ATOMIC, opcode = NOP_EXPR;
+  bool structured_block = false;
 
+  if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+    {
+      tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+      const char *p = IDENTIFIER_POINTER (id);
+
+      if (!strcmp (p, "read"))
+	code = OMP_ATOMIC_READ;
+      else if (!strcmp (p, "write"))
+	code = NOP_EXPR;
+      else if (!strcmp (p, "update"))
+	code = OMP_ATOMIC;
+      else if (!strcmp (p, "capture"))
+	code = OMP_ATOMIC_CAPTURE_NEW;
+      else
+	p = NULL;
+      if (p)
+	cp_lexer_consume_token (parser->lexer);
+    }
   cp_parser_require_pragma_eol (parser, pragma_tok);
 
+  switch (code)
+    {
+    case OMP_ATOMIC_READ:
+    case NOP_EXPR: /* atomic write */
+      v = cp_parser_unary_expression (parser, /*address_p=*/false,
+				      /*cast_p=*/false, NULL);
+      if (v == error_mark_node)
+	goto saw_error;
+      if (!cp_parser_require (parser, CPP_EQ, RT_EQ))
+	goto saw_error;
+      if (code == NOP_EXPR)
+	lhs = cp_parser_expression (parser, /*cast_p=*/false, NULL);
+      else
+	lhs = cp_parser_unary_expression (parser, /*address_p=*/false,
+					  /*cast_p=*/false, NULL);
+      if (lhs == error_mark_node)
+	goto saw_error;
+      if (code == NOP_EXPR)
+	{
+	  /* atomic write is represented by OMP_ATOMIC with NOP_EXPR
+	     opcode.  */
+	  code = OMP_ATOMIC;
+	  rhs = lhs;
+	  lhs = v;
+	  v = NULL_TREE;
+	}
+      goto done;
+    case OMP_ATOMIC_CAPTURE_NEW:
+      if (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE))
+	{
+	  cp_lexer_consume_token (parser->lexer);
+	  structured_block = true;
+	}
+      else
+	{
+	  v = cp_parser_unary_expression (parser, /*address_p=*/false,
+					  /*cast_p=*/false, NULL);
+	  if (v == error_mark_node)
+	    goto saw_error;
+	  if (!cp_parser_require (parser, CPP_EQ, RT_EQ))
+	    goto saw_error;
+	}
+    default:
+      break;
+    }
+
+restart:
   lhs = cp_parser_unary_expression (parser, /*address_p=*/false,
 				    /*cast_p=*/false, NULL);
+  orig_lhs = lhs;
   switch (TREE_CODE (lhs))
     {
     case ERROR_MARK:
       goto saw_error;
 
-    case PREINCREMENT_EXPR:
     case POSTINCREMENT_EXPR:
+      if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
+	code = OMP_ATOMIC_CAPTURE_OLD;
+      /* FALLTHROUGH */
+    case PREINCREMENT_EXPR:
       lhs = TREE_OPERAND (lhs, 0);
-      code = PLUS_EXPR;
+      opcode = PLUS_EXPR;
       rhs = integer_one_node;
       break;
 
-    case PREDECREMENT_EXPR:
     case POSTDECREMENT_EXPR:
+      if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
+	code = OMP_ATOMIC_CAPTURE_OLD;
+      /* FALLTHROUGH */
+    case PREDECREMENT_EXPR:
       lhs = TREE_OPERAND (lhs, 0);
-      code = MINUS_EXPR;
+      opcode = MINUS_EXPR;
       rhs = integer_one_node;
       break;
 
@@ -24312,48 +24500,123 @@ cp_parser_omp_atomic (cp_parser *parser, cp_token *pragma_tok)
     case MODIFY_EXPR:
       if (TREE_CODE (lhs) == MODIFY_EXPR
 	 && TREE_CODE (TREE_TYPE (TREE_OPERAND (lhs, 0))) == BOOLEAN_TYPE)
-       {
+	{
-	 /* Undo effects of boolean_increment.  */
+	  /* Undo effects of boolean_increment.  */
-	 if (integer_onep (TREE_OPERAND (lhs, 1)))
+	  if (integer_onep (TREE_OPERAND (lhs, 1)))
-	   {
+	    {
-	     /* This is pre or post increment.  */
+	      /* This is pre or post increment.  */
-	     rhs = TREE_OPERAND (lhs, 1);
+	      rhs = TREE_OPERAND (lhs, 1);
-	     lhs = TREE_OPERAND (lhs, 0);
+	      lhs = TREE_OPERAND (lhs, 0);
-	     code = NOP_EXPR;
+	      opcode = NOP_EXPR;
-	     break;
+	      if (code == OMP_ATOMIC_CAPTURE_NEW
-	   }
+		  && !structured_block
-       }
+		  && TREE_CODE (orig_lhs) == COMPOUND_EXPR)
+		code = OMP_ATOMIC_CAPTURE_OLD;
+	      break;
+	    }
+	}
       /* FALLTHRU */
     default:
       switch (cp_lexer_peek_token (parser->lexer)->type)
 	{
 	case CPP_MULT_EQ:
-	  code = MULT_EXPR;
+	  opcode = MULT_EXPR;
 	  break;
 	case CPP_DIV_EQ:
-	  code = TRUNC_DIV_EXPR;
+	  opcode = TRUNC_DIV_EXPR;
 	  break;
 	case CPP_PLUS_EQ:
-	  code = PLUS_EXPR;
+	  opcode = PLUS_EXPR;
 	  break;
 	case CPP_MINUS_EQ:
-	  code = MINUS_EXPR;
+	  opcode = MINUS_EXPR;
 	  break;
 	case CPP_LSHIFT_EQ:
-	  code = LSHIFT_EXPR;
+	  opcode = LSHIFT_EXPR;
 	  break;
 	case CPP_RSHIFT_EQ:
-	  code = RSHIFT_EXPR;
+	  opcode = RSHIFT_EXPR;
 	  break;
 	case CPP_AND_EQ:
-	  code = BIT_AND_EXPR;
+	  opcode = BIT_AND_EXPR;
 	  break;
 	case CPP_OR_EQ:
-	  code = BIT_IOR_EXPR;
+	  opcode = BIT_IOR_EXPR;
 	  break;
 	case CPP_XOR_EQ:
-	  code = BIT_XOR_EXPR;
+	  opcode = BIT_XOR_EXPR;
 	  break;
+	case CPP_EQ:
+	  if (structured_block || code == OMP_ATOMIC)
+	    {
+	      enum cp_parser_prec oprec;
+	      cp_token *token;
+	      cp_lexer_consume_token (parser->lexer);
+	      rhs1 = cp_parser_unary_expression (parser, /*address_p=*/false,
+						 /*cast_p=*/false, NULL);
+	      if (rhs1 == error_mark_node)
+		goto saw_error;
+	      token = cp_lexer_peek_token (parser->lexer);
+	      switch (token->type)
+		{
+		case CPP_SEMICOLON:
+		  if (code == OMP_ATOMIC_CAPTURE_NEW)
+		    {
+		      code = OMP_ATOMIC_CAPTURE_OLD;
+		      v = lhs;
+		      lhs = NULL_TREE;
+		      lhs1 = rhs1;
+		      rhs1 = NULL_TREE;
+		      cp_lexer_consume_token (parser->lexer);
+		      goto restart;
+		    }
+		  cp_parser_error (parser,
+				   "invalid form of %<#pragma omp atomic%>");
+		  goto saw_error;
+		case CPP_MULT:
+		  opcode = MULT_EXPR;
+		  break;
+		case CPP_DIV:
+		  opcode = TRUNC_DIV_EXPR;
+		  break;
+		case CPP_PLUS:
+		  opcode = PLUS_EXPR;
+		  break;
+		case CPP_MINUS:
+		  opcode = MINUS_EXPR;
+		  break;
+		case CPP_LSHIFT:
+		  opcode = LSHIFT_EXPR;
+		  break;
+		case CPP_RSHIFT:
+		  opcode = RSHIFT_EXPR;
+		  break;
+		case CPP_AND:
+		  opcode = BIT_AND_EXPR;
+		  break;
+		case CPP_OR:
+		  opcode = BIT_IOR_EXPR;
+		  break;
+		case CPP_XOR:
+		  opcode = BIT_XOR_EXPR;
+		  break;
+		default:
+		  cp_parser_error (parser,
+				   "invalid operator for %<#pragma omp atomic%>");
+		  goto saw_error;
+		}
+	      oprec = TOKEN_PRECEDENCE (token);
+	      gcc_assert (oprec != PREC_NOT_OPERATOR);
+	      if (commutative_tree_code (opcode))
+		oprec = (enum cp_parser_prec) (oprec - 1);
+	      cp_lexer_consume_token (parser->lexer);
+	      rhs = cp_parser_binary_expression (parser, false, false,
+						 oprec, NULL);
+	      if (rhs == error_mark_node)
+		goto saw_error;
+	      goto stmt_done;
+	    }
+	  /* FALLTHROUGH */
 	default:
 	  cp_parser_error (parser,
 			   "invalid operator for %<#pragma omp atomic%>");
@@ -24366,12 +24629,46 @@ cp_parser_omp_atomic (cp_parser *parser, cp_token *pragma_tok)
 	goto saw_error;
       break;
     }
-  finish_omp_atomic (code, lhs, rhs);
+stmt_done:
-  cp_parser_consume_semicolon_at_end_of_statement (parser);
+  if (structured_block && code == OMP_ATOMIC_CAPTURE_NEW)
+    {
+      if (!cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON))
+	goto saw_error;
+      v = cp_parser_unary_expression (parser, /*address_p=*/false,
+				      /*cast_p=*/false, NULL);
+      if (v == error_mark_node)
+	goto saw_error;
+      if (!cp_parser_require (parser, CPP_EQ, RT_EQ))
+	goto saw_error;
+      lhs1 = cp_parser_unary_expression (parser, /*address_p=*/false,
+					 /*cast_p=*/false, NULL);
+      if (lhs1 == error_mark_node)
+	goto saw_error;
+    }
+  if (structured_block)
+    {
+      cp_parser_consume_semicolon_at_end_of_statement (parser);
+      cp_parser_require (parser, CPP_CLOSE_BRACE, RT_CLOSE_BRACE);
+    }
+done:
+  finish_omp_atomic (code, opcode, lhs, rhs, v, lhs1, rhs1);
+  if (!structured_block)
+    cp_parser_consume_semicolon_at_end_of_statement (parser);
   return;
 
  saw_error:
   cp_parser_skip_to_end_of_block_or_statement (parser);
+  if (structured_block)
+    {
+      if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE))
+        cp_lexer_consume_token (parser->lexer);
+      else if (code == OMP_ATOMIC_CAPTURE_NEW)
+	{
+	  cp_parser_skip_to_end_of_block_or_statement (parser);
+	  if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE))
+	    cp_lexer_consume_token (parser->lexer);
+	}
+    }
 }
 
 
@@ -25233,7 +25530,9 @@ cp_parser_omp_single (cp_parser *parser, cp_token *pragma_tok)
 	| (1u << PRAGMA_OMP_CLAUSE_DEFAULT)		\
 	| (1u << PRAGMA_OMP_CLAUSE_PRIVATE)		\
 	| (1u << PRAGMA_OMP_CLAUSE_FIRSTPRIVATE)	\
-	| (1u << PRAGMA_OMP_CLAUSE_SHARED))
+	| (1u << PRAGMA_OMP_CLAUSE_SHARED)		\
+	| (1u << PRAGMA_OMP_CLAUSE_FINAL)		\
+	| (1u << PRAGMA_OMP_CLAUSE_MERGEABLE))
 
 static tree
 cp_parser_omp_task (cp_parser *parser, cp_token *pragma_tok)
@@ -25260,6 +25559,16 @@ cp_parser_omp_taskwait (cp_parser *parser, cp_token *pragma_tok)
   finish_omp_taskwait ();
 }
 
+/* OpenMP 3.1:
+   # pragma omp taskyield new-line  */
+
+static void
+cp_parser_omp_taskyield (cp_parser *parser, cp_token *pragma_tok)
+{
+  cp_parser_require_pragma_eol (parser, pragma_tok);
+  finish_omp_taskyield ();
+}
+
 /* OpenMP 2.5:
    # pragma omp threadprivate (variable-list) */
 
@@ -25435,6 +25744,22 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context)
 	}
       break;
 
+    case PRAGMA_OMP_TASKYIELD:
+      switch (context)
+	{
+	case pragma_compound:
+	  cp_parser_omp_taskyield (parser, pragma_tok);
+	  return false;
+	case pragma_stmt:
+	  error_at (pragma_tok->location,
+		    "%<#pragma omp taskyield%> may only be "
+		    "used in compound statements");
+	  break;
+	default:
+	  goto bad_stmt;
+	}
+      break;
+
     case PRAGMA_OMP_THREADPRIVATE:
       cp_parser_omp_threadprivate (parser, pragma_tok);
       return false;

gcc/cp/pt.c

@@ -12181,6 +12181,7 @@ tsubst_omp_clauses (tree clauses, tree args, tsubst_flags_t complain,
 	case OMP_CLAUSE_NUM_THREADS:
 	case OMP_CLAUSE_SCHEDULE:
 	case OMP_CLAUSE_COLLAPSE:
+	case OMP_CLAUSE_FINAL:
 	  OMP_CLAUSE_OPERAND (nc, 0)
 	    = tsubst_expr (OMP_CLAUSE_OPERAND (oc, 0), args, complain, 
 			   in_decl, /*integral_constant_expression_p=*/false);
@@ -12189,6 +12190,7 @@ tsubst_omp_clauses (tree clauses, tree args, tsubst_flags_t complain,
 	case OMP_CLAUSE_ORDERED:
 	case OMP_CLAUSE_DEFAULT:
 	case OMP_CLAUSE_UNTIED:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 	default:
 	  gcc_unreachable ();
@@ -12819,12 +12821,56 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl,
 
     case OMP_ATOMIC:
       gcc_assert (OMP_ATOMIC_DEPENDENT_P (t));
-      {
+      if (TREE_CODE (TREE_OPERAND (t, 1)) != MODIFY_EXPR)
-	tree op1 = TREE_OPERAND (t, 1);
+	{
-	tree lhs = RECUR (TREE_OPERAND (op1, 0));
+	  tree op1 = TREE_OPERAND (t, 1);
-	tree rhs = RECUR (TREE_OPERAND (op1, 1));
+	  tree rhs1 = NULL_TREE;
-	finish_omp_atomic (TREE_CODE (op1), lhs, rhs);
+	  tree lhs, rhs;
-      }
+	  if (TREE_CODE (op1) == COMPOUND_EXPR)
+	    {
+	      rhs1 = RECUR (TREE_OPERAND (op1, 0));
+	      op1 = TREE_OPERAND (op1, 1);
+	    }
+	  lhs = RECUR (TREE_OPERAND (op1, 0));
+	  rhs = RECUR (TREE_OPERAND (op1, 1));
+	  finish_omp_atomic (OMP_ATOMIC, TREE_CODE (op1), lhs, rhs,
+			     NULL_TREE, NULL_TREE, rhs1);
+	}
+      else
+	{
+	  tree op1 = TREE_OPERAND (t, 1);
+	  tree v = NULL_TREE, lhs, rhs = NULL_TREE, lhs1 = NULL_TREE;
+	  tree rhs1 = NULL_TREE;
+	  enum tree_code code = TREE_CODE (TREE_OPERAND (op1, 1));
+	  enum tree_code opcode = NOP_EXPR;
+	  if (code == OMP_ATOMIC_READ)
+	    {
+	      v = RECUR (TREE_OPERAND (op1, 0));
+	      lhs = RECUR (TREE_OPERAND (TREE_OPERAND (op1, 1), 0));
+	    }
+	  else if (code == OMP_ATOMIC_CAPTURE_OLD
+		   || code == OMP_ATOMIC_CAPTURE_NEW)
+	    {
+	      tree op11 = TREE_OPERAND (TREE_OPERAND (op1, 1), 1);
+	      v = RECUR (TREE_OPERAND (op1, 0));
+	      lhs1 = RECUR (TREE_OPERAND (TREE_OPERAND (op1, 1), 0));
+	      if (TREE_CODE (op11) == COMPOUND_EXPR)
+		{
+		  rhs1 = RECUR (TREE_OPERAND (op11, 0));
+		  op11 = TREE_OPERAND (op11, 1);
+		}
+	      lhs = RECUR (TREE_OPERAND (op11, 0));
+	      rhs = RECUR (TREE_OPERAND (op11, 1));
+	      opcode = TREE_CODE (op11);
+	    }
+	  else
+	    {
+	      code = OMP_ATOMIC;
+	      lhs = RECUR (TREE_OPERAND (op1, 0));
+	      rhs = RECUR (TREE_OPERAND (op1, 1));
+	    }
+	  finish_omp_atomic (code, opcode, lhs, rhs, v, lhs1, rhs1);
+	}
       break;
 
     case EXPR_PACK_EXPANSION:

gcc/cp/semantics.c

@@ -3905,6 +3905,14 @@ finish_omp_clauses (tree clauses)
 	  OMP_CLAUSE_IF_EXPR (c) = t;
 	  break;
 
+	case OMP_CLAUSE_FINAL:
+	  t = OMP_CLAUSE_FINAL_EXPR (c);
+	  t = maybe_convert_cond (t);
+	  if (t == error_mark_node)
+	    remove = true;
+	  OMP_CLAUSE_FINAL_EXPR (c) = t;
+	  break;
+
 	case OMP_CLAUSE_NUM_THREADS:
 	  t = OMP_CLAUSE_NUM_THREADS_EXPR (c);
 	  if (t == error_mark_node)
@@ -3936,6 +3944,7 @@ finish_omp_clauses (tree clauses)
 	case OMP_CLAUSE_DEFAULT:
 	case OMP_CLAUSE_UNTIED:
 	case OMP_CLAUSE_COLLAPSE:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	default:
@@ -4030,6 +4039,8 @@ finish_omp_clauses (tree clauses)
 		case PLUS_EXPR:
 		case MULT_EXPR:
 		case MINUS_EXPR:
+		case MIN_EXPR:
+		case MAX_EXPR:
 		  break;
 		default:
 		  error ("%qE has invalid type for %<reduction(%s)%>",
@@ -4074,6 +4085,10 @@ finish_omp_clauses (tree clauses)
 	    case OMP_CLAUSE_DEFAULT_UNSPECIFIED:
 	      break;
 	    case OMP_CLAUSE_DEFAULT_SHARED:
+	      /* const vars may be specified in firstprivate clause.  */
+	      if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
+		  && cxx_omp_const_qual_no_mutable (t))
+		break;
 	      share_name = "shared";
 	      break;
 	    case OMP_CLAUSE_DEFAULT_PRIVATE:
@@ -4697,15 +4712,22 @@ finish_omp_for (location_t locus, tree declv, tree initv, tree condv,
 }
 
 void
-finish_omp_atomic (enum tree_code code, tree lhs, tree rhs)
+finish_omp_atomic (enum tree_code code, enum tree_code opcode, tree lhs,
+		   tree rhs, tree v, tree lhs1, tree rhs1)
 {
   tree orig_lhs;
   tree orig_rhs;
+  tree orig_v;
+  tree orig_lhs1;
+  tree orig_rhs1;
   bool dependent_p;
   tree stmt;
 
   orig_lhs = lhs;
   orig_rhs = rhs;
+  orig_v = v;
+  orig_lhs1 = lhs1;
+  orig_rhs1 = rhs1;
   dependent_p = false;
   stmt = NULL_TREE;
 
@@ -4714,22 +4736,53 @@ finish_omp_atomic (enum tree_code code, tree lhs, tree rhs)
   if (processing_template_decl)
     {
       dependent_p = (type_dependent_expression_p (lhs)
-		     || type_dependent_expression_p (rhs));
+		     || (rhs && type_dependent_expression_p (rhs))
+		     || (v && type_dependent_expression_p (v))
+		     || (lhs1 && type_dependent_expression_p (lhs1))
+		     || (rhs1 && type_dependent_expression_p (rhs1)));
       if (!dependent_p)
 	{
 	  lhs = build_non_dependent_expr (lhs);
-	  rhs = build_non_dependent_expr (rhs);
+	  if (rhs)
+	    rhs = build_non_dependent_expr (rhs);
+	  if (v)
+	    v = build_non_dependent_expr (v);
+	  if (lhs1)
+	    lhs1 = build_non_dependent_expr (lhs1);
+	  if (rhs1)
+	    rhs1 = build_non_dependent_expr (rhs1);
 	}
     }
   if (!dependent_p)
     {
-      stmt = c_finish_omp_atomic (input_location, code, lhs, rhs);
+      stmt = c_finish_omp_atomic (input_location, code, opcode, lhs, rhs,
+				  v, lhs1, rhs1);
       if (stmt == error_mark_node)
 	return;
     }
   if (processing_template_decl)
-    stmt = build2 (OMP_ATOMIC, void_type_node, integer_zero_node,
+    {
-		   build2 (code, void_type_node, orig_lhs, orig_rhs));
+      if (code == OMP_ATOMIC_READ)
+	{
+	  stmt = build_min_nt (OMP_ATOMIC_READ, orig_lhs);
+	  stmt = build2 (MODIFY_EXPR, void_type_node, orig_v, stmt);
+	}
+      else
+	{
+	  if (opcode == NOP_EXPR)
+	    stmt = build2 (MODIFY_EXPR, void_type_node, orig_lhs, orig_rhs);
+	  else 
+	    stmt = build2 (opcode, void_type_node, orig_lhs, orig_rhs);
+	  if (orig_rhs1)
+	    stmt = build_min_nt (COMPOUND_EXPR, orig_rhs1, stmt);
+	  if (code != OMP_ATOMIC)
+	    {
+	      stmt = build_min_nt (code, orig_lhs1, stmt);
+	      stmt = build2 (MODIFY_EXPR, void_type_node, orig_v, stmt);
+	    }
+	}
+      stmt = build2 (OMP_ATOMIC, void_type_node, integer_zero_node, stmt);
+    }
   add_stmt (stmt);
 }
 
@@ -4762,6 +4815,16 @@ finish_omp_taskwait (void)
   release_tree_vector (vec);
   finish_expr_stmt (stmt);
 }
+
+void
+finish_omp_taskyield (void)
+{
+  tree fn = built_in_decls[BUILT_IN_GOMP_TASKYIELD];
+  VEC(tree,gc) *vec = make_tree_vector ();
+  tree stmt = finish_call_expr (fn, &vec, false, false, tf_warning_or_error);
+  release_tree_vector (vec);
+  finish_expr_stmt (stmt);
+}
 
 void
 init_cp_semantics (void)

gcc/doc/generic.texi

@@ -2210,7 +2210,9 @@ Clauses are represented by separate sub-codes defined in
 @code{OMP_CLAUSE_COPYPRIVATE}, @code{OMP_CLAUSE_IF},
 @code{OMP_CLAUSE_NUM_THREADS}, @code{OMP_CLAUSE_SCHEDULE},
 @code{OMP_CLAUSE_NOWAIT}, @code{OMP_CLAUSE_ORDERED},
-@code{OMP_CLAUSE_DEFAULT}, and @code{OMP_CLAUSE_REDUCTION}.  Each code
+@code{OMP_CLAUSE_DEFAULT}, @code{OMP_CLAUSE_REDUCTION},
+@code{OMP_CLAUSE_COLLAPSE}, @code{OMP_CLAUSE_UNTIED},
+@code{OMP_CLAUSE_FINAL}, and @code{OMP_CLAUSE_MERGEABLE}.  Each code
 represents the corresponding OpenMP clause.
 
 Clauses associated with the same directive are chained together

gcc/fortran/ChangeLog

@@ -1,3 +1,60 @@
+2011-08-02  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/46752
+	* cpp.c (cpp_define_builtins): Change _OPENMP to 201107.
+	* openmp.c (gfc_free_omp_clauses): Free also final_expr.
+	(OMP_CLAUSE_FINAL, OMP_CLAUSE_MERGEABLE): Define.
+	(gfc_match_omp_clauses): Handle parsing final and mergeable
+	clauses.
+	(OMP_TASK_CLAUSES): Allow final and mergeable clauses.
+	(gfc_match_omp_taskyield): New function.
+	(resolve_omp_clauses): Resolve final clause.  Allow POINTERs and
+	Cray pointers in clauses other than REDUCTION.
+	(gfc_match_omp_atomic): Match optional
+	read/write/update/capture keywords after !$omp atomic.
+	(resolve_omp_atomic): Handle all OpenMP 3.1 atomic forms.
+	* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_TASKYIELD,
+	print final and mergeable clauses.
+	(show_code_node): Handle EXEC_OMP_TASKYIELD.
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle final and
+	mergeable clauses.
+	(gfc_trans_omp_taskyield): New function.
+	(gfc_trans_omp_directive): Handle EXEC_OMP_TASKYIELD.
+	(gfc_trans_omp_atomic): Handle all OpenMP 3.1 atomic forms.
+	(gfc_omp_clause_copy_ctor): Handle non-allocated allocatable.
+	(gfc_omp_predetermined_sharing): Adjust comment.
+	* gfortran.h (gfc_statement): Add ST_OMP_TASKYIELD and
+	ST_OMP_END_ATOMIC.
+	(gfc_omp_clauses): Add final_expr and mergeable fields.
+	(gfc_exec_op): Add EXEC_OMP_TASKYIELD.
+	(gfc_omp_atomic_op): New enum typedef.
+	(struct gfc_code): Add ext.omp_atomic.
+	* trans.c (trans_code): Handle EXEC_OMP_TASKYIELD.
+	* frontend-passes.c (gfc_code_walker): Also walk final_expr.
+	* resolve.c (gfc_resolve_blocks, resolve_code): Handle
+	EXEC_OMP_TASKYIELD.
+	* st.c (gfc_free_statement): Likewise.
+	* match.h (gfc_match_omp_taskyield): New prototype.
+	* parse.c (decode_omp_directive): Handle taskyield directive.
+	Handle !$omp end atomic.
+	(case_executable): Add ST_OMP_TASKYIELD case.
+	(gfc_ascii_statement): Handle ST_OMP_TASKYIELD.
+	(parse_omp_atomic): Return gfc_statement instead of void.
+	For !$omp atomic capture parse two assignments instead of
+	just one and require !$omp end atomic afterwards, for
+	other !$omp atomic forms just allow !$omp end atomic at the
+	end.
+	(parse_omp_structured_block, parse_executable): Adjust
+	parse_omp_atomic callers.
+
+2011-08-02  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.c (OMP_LIB): Updated openmp_version's
+	value to 201107.
+	* gfortran.texi (OpenMP): Update ref to OpenMP 3.1.
+	* intrinsic.texi (OpenMP Modules): Update ref to OpenMP 3.1;
+	remove deleted omp_integer_kind and omp_logical_kind constants.
+
 2011-07-31  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/49112

gcc/fortran/cpp.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -166,7 +166,7 @@ cpp_define_builtins (cpp_reader *pfile)
   cpp_define (pfile, "_LANGUAGE_FORTRAN=1");
 
   if (gfc_option.gfc_flag_openmp)
-    cpp_define (pfile, "_OPENMP=200805");
+    cpp_define (pfile, "_OPENMP=201107");
 
   /* The defines below are necessary for the TARGET_* macros.
 

gcc/fortran/dump-parse-tree.c

@@ -1039,6 +1039,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_SINGLE: name = "SINGLE"; break;
     case EXEC_OMP_TASK: name = "TASK"; break;
     case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
+    case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
     case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
     default:
       gcc_unreachable ();
@@ -1071,6 +1072,7 @@ show_omp_node (int level, gfc_code *c)
       return;
     case EXEC_OMP_BARRIER:
     case EXEC_OMP_TASKWAIT:
+    case EXEC_OMP_TASKYIELD:
       return;
     default:
       break;
@@ -1085,6 +1087,12 @@ show_omp_node (int level, gfc_code *c)
 	  show_expr (omp_clauses->if_expr);
 	  fputc (')', dumpfile);
 	}
+      if (omp_clauses->final_expr)
+	{
+	  fputs (" FINAL(", dumpfile);
+	  show_expr (omp_clauses->final_expr);
+	  fputc (')', dumpfile);
+	}
       if (omp_clauses->num_threads)
 	{
 	  fputs (" NUM_THREADS(", dumpfile);
@@ -1130,6 +1138,8 @@ show_omp_node (int level, gfc_code *c)
 	fputs (" ORDERED", dumpfile);
       if (omp_clauses->untied)
 	fputs (" UNTIED", dumpfile);
+      if (omp_clauses->mergeable)
+	fputs (" MERGEABLE", dumpfile);
       if (omp_clauses->collapse)
 	fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
       for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
@@ -2167,6 +2177,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_SINGLE:
     case EXEC_OMP_TASK:
     case EXEC_OMP_TASKWAIT:
+    case EXEC_OMP_TASKYIELD:
     case EXEC_OMP_WORKSHARE:
       show_omp_node (level, c);
       break;

gcc/fortran/frontend-passes.c

@@ -1235,6 +1235,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	      if (co->ext.omp_clauses)
 		{
 		  WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
+		  WALK_SUBEXPR (co->ext.omp_clauses->final_expr);
 		  WALK_SUBEXPR (co->ext.omp_clauses->num_threads);
 		  WALK_SUBEXPR (co->ext.omp_clauses->chunk_size);
 		}

gcc/fortran/gfortran.h

@@ -199,16 +199,16 @@ typedef enum
   ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
   ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
   ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
-  ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
+  ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
-  ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
+  ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
-  ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
+  ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
   ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
   ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
   ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
   ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
   ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
-  ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
+  ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL,
-  ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
+  ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
 }
 gfc_statement;
 
@@ -1050,13 +1050,14 @@ enum gfc_omp_default_sharing
 typedef struct gfc_omp_clauses
 {
   struct gfc_expr *if_expr;
+  struct gfc_expr *final_expr;
   struct gfc_expr *num_threads;
   gfc_namelist *lists[OMP_LIST_NUM];
   enum gfc_omp_sched_kind sched_kind;
   struct gfc_expr *chunk_size;
   enum gfc_omp_default_sharing default_sharing;
   int collapse;
-  bool nowait, ordered, untied;
+  bool nowait, ordered, untied, mergeable;
 }
 gfc_omp_clauses;
 
@@ -2064,10 +2065,20 @@ typedef enum
   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
   EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
   EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
-  EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT
+  EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
+  EXEC_OMP_TASKYIELD
 }
 gfc_exec_op;
 
+typedef enum
+{
+  GFC_OMP_ATOMIC_UPDATE,
+  GFC_OMP_ATOMIC_READ,
+  GFC_OMP_ATOMIC_WRITE,
+  GFC_OMP_ATOMIC_CAPTURE
+}
+gfc_omp_atomic_op;
+
 typedef struct gfc_code
 {
   gfc_exec_op op;
@@ -2118,6 +2129,7 @@ typedef struct gfc_code
     const char *omp_name;
     gfc_namelist *omp_namelist;
     bool omp_bool;
+    gfc_omp_atomic_op omp_atomic;
   }
   ext;		/* Points to additional structures required by statement */
 

gcc/fortran/gfortran.texi

@@ -530,7 +530,7 @@ support is reported in the @ref{Fortran 2003 status} and
 @ref{Fortran 2008 status} sections of the documentation.
 
 Additionally, the GNU Fortran compilers supports the OpenMP specification
-(version 3.0, @url{http://openmp.org/@/wp/@/openmp-specifications/}).
+(version 3.1, @url{http://openmp.org/@/wp/@/openmp-specifications/}).
 
 @node Varying Length Character Strings
 @subsection Varying Length Character Strings
@@ -1762,8 +1762,8 @@ It consists of a set of compiler directives, library routines,
 and environment variables that influence run-time behavior.
 
 GNU Fortran strives to be compatible to the 
-@uref{http://www.openmp.org/mp-documents/spec30.pdf,
+@uref{http://www.openmp.org/mp-documents/spec31.pdf,
-OpenMP Application Program Interface v3.0}.
+OpenMP Application Program Interface v3.1}.
 
 To enable the processing of the OpenMP directive @code{!$omp} in
 free-form source code; the @code{c$omp}, @code{*$omp} and @code{!$omp}

gcc/fortran/intrinsic.texi

@@ -13072,7 +13072,7 @@ Both are equivalent to the value @code{NULL} in C.
 @section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS}
 @table @asis
 @item @emph{Standard}:
-OpenMP Application Program Interface v3.0
+OpenMP Application Program Interface v3.1
 @end table
 
 
@@ -13085,15 +13085,13 @@ the named constants defined in the modules are listed
 below.
 
 For details refer to the actual
-@uref{http://www.openmp.org/mp-documents/spec30.pdf,
+@uref{http://www.openmp.org/mp-documents/spec31.pdf,
-OpenMP Application Program Interface v3.0}.
+OpenMP Application Program Interface v3.1}.
 
 @code{OMP_LIB_KINDS} provides the following scalar default-integer
 named constants:
 
 @table @asis
-@item @code{omp_integer_kind}
-@item @code{omp_logical_kind}
 @item @code{omp_lock_kind}
 @item @code{omp_nest_lock_kind}
 @item @code{omp_sched_kind}
@@ -13102,7 +13100,7 @@ named constants:
 @code{OMP_LIB} provides the scalar default-integer
 named constant @code{openmp_version} with a value of the form
 @var{yyyymm}, where @code{yyyy} is the year and @var{mm} the month
-of the OpenMP version; for OpenMP v3.0 the value is @code{200805}.
+of the OpenMP version; for OpenMP v3.1 the value is @code{201107}.
 
 And the following scalar integer named constants of the
 kind @code{omp_sched_kind}:

gcc/fortran/match.h

@@ -138,6 +138,7 @@ match gfc_match_omp_sections (void);
 match gfc_match_omp_single (void);
 match gfc_match_omp_task (void);
 match gfc_match_omp_taskwait (void);
+match gfc_match_omp_taskyield (void);
 match gfc_match_omp_threadprivate (void);
 match gfc_match_omp_workshare (void);
 match gfc_match_omp_end_nowait (void);

gcc/fortran/openmp.c

@@ -1,5 +1,5 @@
 /* OpenMP directive matching and resolving.
-   Copyright (C) 2005, 2006, 2007, 2008, 2010
+   Copyright (C) 2005, 2006, 2007, 2008, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Jakub Jelinek
 
@@ -66,6 +66,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
     return;
 
   gfc_free_expr (c->if_expr);
+  gfc_free_expr (c->final_expr);
   gfc_free_expr (c->num_threads);
   gfc_free_expr (c->chunk_size);
   for (i = 0; i < OMP_LIST_NUM; i++)
@@ -182,6 +183,8 @@ cleanup:
 #define OMP_CLAUSE_ORDERED	(1 << 11)
 #define OMP_CLAUSE_COLLAPSE	(1 << 12)
 #define OMP_CLAUSE_UNTIED	(1 << 13)
+#define OMP_CLAUSE_FINAL	(1 << 14)
+#define OMP_CLAUSE_MERGEABLE	(1 << 15)
 
 /* Match OpenMP directive clauses. MASK is a bitmask of
    clauses that are allowed for a particular directive.  */
@@ -205,6 +208,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
       if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
 	  && gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
 	continue;
+      if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL
+	  && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
+	continue;
       if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
 	  && gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
 	continue;
@@ -383,6 +389,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
 	  c->untied = needs_space = true;
 	  continue;
 	}
+      if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
+	  && gfc_match ("mergeable") == MATCH_YES)
+	{
+	  c->mergeable = needs_space = true;
+	  continue;
+	}
       if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse)
 	{
 	  gfc_expr *cexpr = NULL;
@@ -435,7 +447,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
 #define OMP_TASK_CLAUSES \
   (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED	\
-   | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED)
+   | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED		\
+   | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
 
 match
 gfc_match_omp_parallel (void)
@@ -475,6 +488,20 @@ gfc_match_omp_taskwait (void)
 }
 
 
+match
+gfc_match_omp_taskyield (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after TASKYIELD clause at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_TASKYIELD;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
 match
 gfc_match_omp_critical (void)
 {
@@ -700,13 +727,22 @@ gfc_match_omp_ordered (void)
 match
 gfc_match_omp_atomic (void)
 {
+  gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE;
+  if (gfc_match ("% update") == MATCH_YES)
+    op = GFC_OMP_ATOMIC_UPDATE;
+  else if (gfc_match ("% read") == MATCH_YES)
+    op = GFC_OMP_ATOMIC_READ;
+  else if (gfc_match ("% write") == MATCH_YES)
+    op = GFC_OMP_ATOMIC_WRITE;
+  else if (gfc_match ("% capture") == MATCH_YES)
+    op = GFC_OMP_ATOMIC_CAPTURE;
   if (gfc_match_omp_eos () != MATCH_YES)
     {
       gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C");
       return MATCH_ERROR;
     }
   new_st.op = EXEC_OMP_ATOMIC;
-  new_st.ext.omp_clauses = NULL;
+  new_st.ext.omp_atomic = op;
   return MATCH_YES;
 }
 
@@ -783,6 +819,14 @@ resolve_omp_clauses (gfc_code *code)
 	gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
 		   &expr->where);
     }
+  if (omp_clauses->final_expr)
+    {
+      gfc_expr *expr = omp_clauses->final_expr;
+      if (gfc_resolve_expr (expr) == FAILURE
+	  || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+	gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
+		   &expr->where);
+    }
   if (omp_clauses->num_threads)
     {
       gfc_expr *expr = omp_clauses->num_threads;
@@ -940,15 +984,20 @@ resolve_omp_clauses (gfc_code *code)
 			    n->sym->name, name, &code->loc);
 		if (list != OMP_LIST_PRIVATE)
 		  {
-		    if (n->sym->attr.pointer)
+		    if (n->sym->attr.pointer
+			&& list >= OMP_LIST_REDUCTION_FIRST
+			&& list <= OMP_LIST_REDUCTION_LAST)
 		      gfc_error ("POINTER object '%s' in %s clause at %L",
 				 n->sym->name, name, &code->loc);
 		    /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below).  */
-		    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
+		    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST)
-		        n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
+			 && n->sym->ts.type == BT_DERIVED
+			 && n->sym->ts.u.derived->attr.alloc_comp)
 		      gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
 				 name, n->sym->name, &code->loc);
-		    if (n->sym->attr.cray_pointer)
+		    if (n->sym->attr.cray_pointer
+			&& list >= OMP_LIST_REDUCTION_FIRST
+			&& list <= OMP_LIST_REDUCTION_LAST)
 		      gfc_error ("Cray pointer '%s' in %s clause at %L",
 				 n->sym->name, name, &code->loc);
 		  }
@@ -1095,12 +1144,18 @@ is_conversion (gfc_expr *expr, bool widening)
 static void
 resolve_omp_atomic (gfc_code *code)
 {
+  gfc_code *atomic_code = code;
   gfc_symbol *var;
-  gfc_expr *expr2;
+  gfc_expr *expr2, *expr2_tmp;
 
   code = code->block->next;
   gcc_assert (code->op == EXEC_ASSIGN);
-  gcc_assert (code->next == NULL);
+  gcc_assert ((atomic_code->ext.omp_atomic != GFC_OMP_ATOMIC_CAPTURE
+	       && code->next == NULL)
+	      || (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE
+		  && code->next != NULL
+		  && code->next->op == EXEC_ASSIGN
+		  && code->next->next == NULL));
 
   if (code->expr1->expr_type != EXPR_VARIABLE
       || code->expr1->symtree == NULL
@@ -1118,7 +1173,86 @@ resolve_omp_atomic (gfc_code *code)
   var = code->expr1->symtree->n.sym;
   expr2 = is_conversion (code->expr2, false);
   if (expr2 == NULL)
-    expr2 = code->expr2;
+    {
+      if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_READ
+	  || atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
+	expr2 = is_conversion (code->expr2, true);
+      if (expr2 == NULL)
+	expr2 = code->expr2;
+    }
+
+  switch (atomic_code->ext.omp_atomic)
+    {
+    case GFC_OMP_ATOMIC_READ:
+      if (expr2->expr_type != EXPR_VARIABLE
+	  || expr2->symtree == NULL
+	  || expr2->rank != 0
+	  || (expr2->ts.type != BT_INTEGER
+	      && expr2->ts.type != BT_REAL
+	      && expr2->ts.type != BT_COMPLEX
+	      && expr2->ts.type != BT_LOGICAL))
+	gfc_error ("!$OMP ATOMIC READ statement must read from a scalar "
+		   "variable of intrinsic type at %L", &expr2->where);
+      return;
+    case GFC_OMP_ATOMIC_WRITE:
+      if (expr2->rank != 0 || expr_references_sym (code->expr2, var, NULL))
+	gfc_error ("expr in !$OMP ATOMIC WRITE assignment var = expr "
+		   "must be scalar and cannot reference var at %L",
+		   &expr2->where);
+      return;
+    case GFC_OMP_ATOMIC_CAPTURE:
+      expr2_tmp = expr2;
+      if (expr2 == code->expr2)
+	{
+	  expr2_tmp = is_conversion (code->expr2, true);
+	  if (expr2_tmp == NULL)
+	    expr2_tmp = expr2;
+	}
+      if (expr2_tmp->expr_type == EXPR_VARIABLE)
+	{
+	  if (expr2_tmp->symtree == NULL
+	      || expr2_tmp->rank != 0
+	      || (expr2_tmp->ts.type != BT_INTEGER
+		  && expr2_tmp->ts.type != BT_REAL
+		  && expr2_tmp->ts.type != BT_COMPLEX
+		  && expr2_tmp->ts.type != BT_LOGICAL)
+	      || expr2_tmp->symtree->n.sym == var)
+	    {
+	      gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read from "
+			 "a scalar variable of intrinsic type at %L",
+			 &expr2_tmp->where);
+	      return;
+	    }
+	  var = expr2_tmp->symtree->n.sym;
+	  code = code->next;
+	  if (code->expr1->expr_type != EXPR_VARIABLE
+	      || code->expr1->symtree == NULL
+	      || code->expr1->rank != 0
+	      || (code->expr1->ts.type != BT_INTEGER
+		  && code->expr1->ts.type != BT_REAL
+		  && code->expr1->ts.type != BT_COMPLEX
+		  && code->expr1->ts.type != BT_LOGICAL))
+	    {
+	      gfc_error ("!$OMP ATOMIC CAPTURE update statement must set "
+			 "a scalar variable of intrinsic type at %L",
+			 &code->expr1->where);
+	      return;
+	    }
+	  if (code->expr1->symtree->n.sym != var)
+	    {
+	      gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
+			 "different variable than update statement writes "
+			 "into at %L", &code->expr1->where);
+	      return;
+	    }
+	  expr2 = is_conversion (code->expr2, false);
+	  if (expr2 == NULL)
+	    expr2 = code->expr2;
+	}
+      break;
+    default:
+      break;
+    }
 
   if (expr2->expr_type == EXPR_OP)
     {
@@ -1320,6 +1454,53 @@ resolve_omp_atomic (gfc_code *code)
   else
     gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic "
 	       "on right hand side at %L", &expr2->where);
+
+  if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE && code->next)
+    {
+      code = code->next;
+      if (code->expr1->expr_type != EXPR_VARIABLE
+	  || code->expr1->symtree == NULL
+	  || code->expr1->rank != 0
+	  || (code->expr1->ts.type != BT_INTEGER
+	      && code->expr1->ts.type != BT_REAL
+	      && code->expr1->ts.type != BT_COMPLEX
+	      && code->expr1->ts.type != BT_LOGICAL))
+	{
+	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement must set "
+		     "a scalar variable of intrinsic type at %L",
+		     &code->expr1->where);
+	  return;
+	}
+
+      expr2 = is_conversion (code->expr2, false);
+      if (expr2 == NULL)
+	{
+	  expr2 = is_conversion (code->expr2, true);
+	  if (expr2 == NULL)
+	    expr2 = code->expr2;
+	}
+
+      if (expr2->expr_type != EXPR_VARIABLE
+	  || expr2->symtree == NULL
+	  || expr2->rank != 0
+	  || (expr2->ts.type != BT_INTEGER
+	      && expr2->ts.type != BT_REAL
+	      && expr2->ts.type != BT_COMPLEX
+	      && expr2->ts.type != BT_LOGICAL))
+	{
+	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read "
+		     "from a scalar variable of intrinsic type at %L",
+		     &expr2->where);
+	  return;
+	}
+      if (expr2->symtree->n.sym != var)
+	{
+	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
+		     "different variable than update statement writes "
+		     "into at %L", &expr2->where);
+	  return;
+	}
+    }
 }
 
 

gcc/fortran/parse.c

@@ -526,6 +526,7 @@ decode_omp_directive (void)
       match ("do", gfc_match_omp_do, ST_OMP_DO);
       break;
     case 'e':
+      match ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC);
       match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL);
       match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
       match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER);
@@ -567,6 +568,7 @@ decode_omp_directive (void)
     case 't':
       match ("task", gfc_match_omp_task, ST_OMP_TASK);
       match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
+      match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD);
       match ("threadprivate", gfc_match_omp_threadprivate,
 	     ST_OMP_THREADPRIVATE);
     case 'w':
@@ -957,9 +959,9 @@ next_statement (void)
   case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
   case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
   case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
-  case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_ERROR_STOP: \
+  case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
-  case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: \
+  case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \
-  case ST_LOCK: case ST_UNLOCK
+  case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK
 
 /* Statements that mark other executable statements.  */
 
@@ -1470,6 +1472,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_DO:
       p = "!$OMP DO";
       break;
+    case ST_OMP_END_ATOMIC:
+      p = "!$OMP END ATOMIC";
+      break;
     case ST_OMP_END_CRITICAL:
       p = "!$OMP END CRITICAL";
       break;
@@ -1542,6 +1547,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_TASKWAIT:
       p = "!$OMP TASKWAIT";
       break;
+    case ST_OMP_TASKYIELD:
+      p = "!$OMP TASKYIELD";
+      break;
     case ST_OMP_THREADPRIVATE:
       p = "!$OMP THREADPRIVATE";
       break;
@@ -3420,12 +3428,13 @@ parse_omp_do (gfc_statement omp_st)
 
 /* Parse the statements of OpenMP atomic directive.  */
 
-static void
+static gfc_statement
 parse_omp_atomic (void)
 {
   gfc_statement st;
   gfc_code *cp, *np;
   gfc_state_data s;
+  int count;
 
   accept_statement (ST_OMP_ATOMIC);
 
@@ -3434,21 +3443,35 @@ parse_omp_atomic (void)
   np = new_level (cp);
   np->op = cp->op;
   np->block = NULL;
+  count = 1 + (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE);
 
-  for (;;)
+  while (count)
     {
       st = next_statement ();
       if (st == ST_NONE)
 	unexpected_eof ();
       else if (st == ST_ASSIGNMENT)
-	break;
+	{
+	  accept_statement (st);
+	  count--;
+	}
       else
 	unexpected_statement (st);
     }
 
-  accept_statement (st);
-
   pop_state ();
+
+  st = next_statement ();
+  if (st == ST_OMP_END_ATOMIC)
+    {
+      gfc_clear_new_st ();
+      gfc_commit_symbols ();
+      gfc_warning_check ();
+      st = next_statement ();
+    }
+  else if (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE)
+    gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C");
+  return st;
 }
 
 
@@ -3558,8 +3581,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 		  continue;
 
 		case ST_OMP_ATOMIC:
-		  parse_omp_atomic ();
+		  st = parse_omp_atomic ();
-		  break;
+		  continue;
 
 		default:
 		  cycle = false;
@@ -3739,8 +3762,8 @@ parse_executable (gfc_statement st)
 	  continue;
 
 	case ST_OMP_ATOMIC:
-	  parse_omp_atomic ();
+	  st = parse_omp_atomic ();
-	  break;
+	  continue;
 
 	default:
 	  return st;

gcc/fortran/resolve.c

@@ -8824,6 +8824,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_SINGLE:
 	case EXEC_OMP_TASK:
 	case EXEC_OMP_TASKWAIT:
+	case EXEC_OMP_TASKYIELD:
 	case EXEC_OMP_WORKSHARE:
 	  break;
 
@@ -9390,6 +9391,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 	case EXEC_OMP_SECTIONS:
 	case EXEC_OMP_SINGLE:
 	case EXEC_OMP_TASKWAIT:
+	case EXEC_OMP_TASKYIELD:
 	case EXEC_OMP_WORKSHARE:
 	  gfc_resolve_omp_directive (code, ns);
 	  break;

gcc/fortran/st.c

@@ -208,6 +208,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_END_NOWAIT:
     case EXEC_OMP_TASKWAIT:
+    case EXEC_OMP_TASKYIELD:
       break;
 
     default:

gcc/fortran/trans-openmp.c

@@ -88,9 +88,7 @@ gfc_omp_predetermined_sharing (tree decl)
   if (GFC_DECL_CRAY_POINTEE (decl))
     return OMP_CLAUSE_DEFAULT_PRIVATE;
 
-  /* Assumed-size arrays are predetermined to inherit sharing
+  /* Assumed-size arrays are predetermined shared.  */
-     attributes of the associated actual argument, which is shared
-     for all we care.  */
   if (TREE_CODE (decl) == PARM_DECL
       && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
@@ -215,7 +213,8 @@ tree
 gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 {
   tree type = TREE_TYPE (dest), ptr, size, esize, rank, call;
-  stmtblock_t block;
+  tree cond, then_b, else_b;
+  stmtblock_t block, cond_block;
 
   if (! GFC_DESCRIPTOR_TYPE_P (type)
       || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
@@ -227,7 +226,9 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
      and copied from SRC.  */
   gfc_start_block (&block);
 
-  gfc_add_modify (&block, dest, src);
+  gfc_init_block (&cond_block);
+
+  gfc_add_modify (&cond_block, dest, src);
   rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
   size = gfc_conv_descriptor_ubound_get (dest, rank);
   size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
@@ -241,18 +242,30 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
   size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 			  size, esize);
-  size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
+  size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
 
   ptr = gfc_create_var (pvoid_type_node, NULL);
-  gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
+  gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
-  gfc_conv_descriptor_data_set (&block, dest, ptr);
+  gfc_conv_descriptor_data_set (&cond_block, dest, ptr);
 
   call = build_call_expr_loc (input_location,
 			  built_in_decls[BUILT_IN_MEMCPY], 3, ptr,
 			  fold_convert (pvoid_type_node,
 					gfc_conv_descriptor_data_get (src)),
 			  size);
-  gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+  gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
+  then_b = gfc_finish_block (&cond_block);
+
+  gfc_init_block (&cond_block);
+  gfc_conv_descriptor_data_set (&cond_block, dest, null_pointer_node);
+  else_b = gfc_finish_block (&cond_block);
+
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			  fold_convert (pvoid_type_node,
+					gfc_conv_descriptor_data_get (src)),
+			  null_pointer_node);
+  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+			 void_type_node, cond, then_b, else_b));
 
   return gfc_finish_block (&block);
 }
@@ -855,6 +868,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
+  if (clauses->final_expr)
+    {
+      tree final_var;
+
+      gfc_init_se (&se, NULL);
+      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);
+      OMP_CLAUSE_FINAL_EXPR (c) = final_var;
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
   if (clauses->num_threads)
     {
       tree num_threads;
@@ -948,6 +976,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
+  if (clauses->mergeable)
+    {
+      c = build_omp_clause (where.lb->location, 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);
@@ -990,35 +1024,85 @@ static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 static tree
 gfc_trans_omp_atomic (gfc_code *code)
 {
+  gfc_code *atomic_code = code;
   gfc_se lse;
   gfc_se rse;
+  gfc_se vse;
   gfc_expr *expr2, *e;
   gfc_symbol *var;
   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;
 
   code = code->block->next;
   gcc_assert (code->op == EXEC_ASSIGN);
-  gcc_assert (code->next == NULL);
   var = code->expr1->symtree->n.sym;
 
   gfc_init_se (&lse, NULL);
   gfc_init_se (&rse, NULL);
+  gfc_init_se (&vse, NULL);
   gfc_start_block (&block);
 
-  gfc_conv_expr (&lse, code->expr1);
-  gfc_add_block_to_block (&block, &lse.pre);
-  type = TREE_TYPE (lse.expr);
-  lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
-
   expr2 = code->expr2;
   if (expr2->expr_type == EXPR_FUNCTION
       && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
     expr2 = expr2->value.function.actual->expr;
 
-  if (expr2->expr_type == EXPR_OP)
+  switch (atomic_code->ext.omp_atomic)
+    {
+    case GFC_OMP_ATOMIC_READ:
+      gfc_conv_expr (&vse, code->expr1);
+      gfc_add_block_to_block (&block, &vse.pre);
+
+      gfc_conv_expr (&lse, expr2);
+      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);
+      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);
+
+      return gfc_finish_block (&block);
+    case GFC_OMP_ATOMIC_CAPTURE:
+      aop = OMP_ATOMIC_CAPTURE_NEW;
+      if (expr2->expr_type == EXPR_VARIABLE)
+	{
+	  aop = OMP_ATOMIC_CAPTURE_OLD;
+	  gfc_conv_expr (&vse, code->expr1);
+	  gfc_add_block_to_block (&block, &vse.pre);
+
+	  gfc_conv_expr (&lse, expr2);
+	  gfc_add_block_to_block (&block, &lse.pre);
+	  gfc_init_se (&lse, NULL);
+	  code = code->next;
+	  var = code->expr1->symtree->n.sym;
+	  expr2 = code->expr2;
+	  if (expr2->expr_type == EXPR_FUNCTION
+	      && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
+	    expr2 = expr2->value.function.actual->expr;
+	}
+      break;
+    default:
+      break;
+    }
+
+  gfc_conv_expr (&lse, code->expr1);
+  gfc_add_block_to_block (&block, &lse.pre);
+  type = TREE_TYPE (lse.expr);
+  lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
+
+  if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
+    {
+      gfc_conv_expr (&rse, expr2);
+      gfc_add_block_to_block (&block, &rse.pre);
+    }
+  else if (expr2->expr_type == EXPR_OP)
     {
       gfc_expr *e;
       switch (expr2->value.op.op)
@@ -1134,25 +1218,55 @@ gfc_trans_omp_atomic (gfc_code *code)
 
   lhsaddr = save_expr (lhsaddr);
   rhs = gfc_evaluate_now (rse.expr, &block);
-  x = convert (TREE_TYPE (rhs), build_fold_indirect_ref_loc (input_location,
-							 lhsaddr));
 
-  if (var_on_left)
+  if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
-    x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
+    x = rhs;
   else
-    x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
+    {
+      x = convert (TREE_TYPE (rhs),
+		   build_fold_indirect_ref_loc (input_location, lhsaddr));
+      if (var_on_left)
+	x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
+      else
+	x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
+    }
 
   if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
       && TREE_CODE (type) != COMPLEX_TYPE)
     x = fold_build1_loc (input_location, REALPART_EXPR,
 			 TREE_TYPE (TREE_TYPE (rhs)), x);
 
-  x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
-  gfc_add_expr_to_block (&block, x);
-
   gfc_add_block_to_block (&block, &lse.pre);
   gfc_add_block_to_block (&block, &rse.pre);
 
+  if (aop == OMP_ATOMIC)
+    {
+      x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
+      gfc_add_expr_to_block (&block, x);
+    }
+  else
+    {
+      if (aop == OMP_ATOMIC_CAPTURE_NEW)
+	{
+	  code = code->next;
+	  expr2 = code->expr2;
+	  if (expr2->expr_type == EXPR_FUNCTION
+	      && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
+	    expr2 = expr2->value.function.actual->expr;
+
+	  gcc_assert (expr2->expr_type == EXPR_VARIABLE);
+	  gfc_conv_expr (&vse, code->expr1);
+	  gfc_add_block_to_block (&block, &vse.pre);
+
+	  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));
+      x = convert (TREE_TYPE (vse.expr), x);
+      gfc_add_modify (&block, vse.expr, x);
+    }
+
   return gfc_finish_block (&block);
 }
 
@@ -1628,6 +1742,13 @@ gfc_trans_omp_taskwait (void)
   return build_call_expr_loc (input_location, decl, 0);
 }
 
+static tree
+gfc_trans_omp_taskyield (void)
+{
+  tree decl = built_in_decls [BUILT_IN_GOMP_TASKYIELD];
+  return build_call_expr_loc (input_location, decl, 0);
+}
+
 static tree
 gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
 {
@@ -1821,6 +1942,8 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_task (code);
     case EXEC_OMP_TASKWAIT:
       return gfc_trans_omp_taskwait ();
+    case EXEC_OMP_TASKYIELD:
+      return gfc_trans_omp_taskyield ();
     case EXEC_OMP_WORKSHARE:
       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
     default:

gcc/fortran/trans.c

@@ -1410,6 +1410,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_SINGLE:
 	case EXEC_OMP_TASK:
 	case EXEC_OMP_TASKWAIT:
+	case EXEC_OMP_TASKYIELD:
 	case EXEC_OMP_WORKSHARE:
 	  res = gfc_trans_omp_directive (code);
 	  break;

gcc/gimple.h

@@ -114,6 +114,7 @@ enum gf_mask {
     GF_OMP_RETURN_NOWAIT	= 1 << 0,
 
     GF_OMP_SECTION_LAST		= 1 << 0,
+    GF_OMP_ATOMIC_NEED_VALUE	= 1 << 0,
     GF_PREDICT_TAKEN		= 1 << 15
 };
 
@@ -1634,6 +1635,29 @@ gimple_omp_parallel_set_combined_p (gimple g, bool combined_p)
 }
 
 
+/* Return true if OMP atomic load/store statement G has the
+   GF_OMP_ATOMIC_NEED_VALUE flag set.  */
+
+static inline bool
+gimple_omp_atomic_need_value_p (const_gimple g)
+{
+  if (gimple_code (g) != GIMPLE_OMP_ATOMIC_LOAD)
+    GIMPLE_CHECK (g, GIMPLE_OMP_ATOMIC_STORE);
+  return (gimple_omp_subcode (g) & GF_OMP_ATOMIC_NEED_VALUE) != 0;
+}
+
+
+/* Set the GF_OMP_ATOMIC_NEED_VALUE flag on G.  */
+
+static inline void
+gimple_omp_atomic_set_need_value (gimple g)
+{
+  if (gimple_code (g) != GIMPLE_OMP_ATOMIC_LOAD)
+    GIMPLE_CHECK (g, GIMPLE_OMP_ATOMIC_STORE);
+  g->gsbase.subcode |= GF_OMP_ATOMIC_NEED_VALUE;
+}
+
+
 /* Return the number of operands for statement GS.  */
 
 static inline unsigned

gcc/gimplify.c

@@ -5932,6 +5932,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
 	    }
 	  break;
 
+	case OMP_CLAUSE_FINAL:
 	case OMP_CLAUSE_IF:
 	  OMP_CLAUSE_OPERAND (c, 0)
 	    = gimple_boolify (OMP_CLAUSE_OPERAND (c, 0));
@@ -5948,6 +5949,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
 	case OMP_CLAUSE_ORDERED:
 	case OMP_CLAUSE_UNTIED:
 	case OMP_CLAUSE_COLLAPSE:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	case OMP_CLAUSE_DEFAULT:
@@ -6088,6 +6090,8 @@ gimplify_adjust_omp_clauses (tree *list_p)
 	case OMP_CLAUSE_DEFAULT:
 	case OMP_CLAUSE_UNTIED:
 	case OMP_CLAUSE_COLLAPSE:
+	case OMP_CLAUSE_FINAL:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	default:
@@ -6490,24 +6494,45 @@ static enum gimplify_status
 gimplify_omp_atomic (tree *expr_p, gimple_seq *pre_p)
 {
   tree addr = TREE_OPERAND (*expr_p, 0);
-  tree rhs = TREE_OPERAND (*expr_p, 1);
+  tree rhs = TREE_CODE (*expr_p) == OMP_ATOMIC_READ
+	     ? NULL : TREE_OPERAND (*expr_p, 1);
   tree type = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (addr)));
   tree tmp_load;
+  gimple loadstmt, storestmt;
 
-   tmp_load = create_tmp_reg (type, NULL);
+  tmp_load = create_tmp_reg (type, NULL);
-   if (goa_stabilize_expr (&rhs, pre_p, addr, tmp_load) < 0)
+  if (rhs && goa_stabilize_expr (&rhs, pre_p, addr, tmp_load) < 0)
-     return GS_ERROR;
+    return GS_ERROR;
 
-   if (gimplify_expr (&addr, pre_p, NULL, is_gimple_val, fb_rvalue)
+  if (gimplify_expr (&addr, pre_p, NULL, is_gimple_val, fb_rvalue)
-       != GS_ALL_DONE)
+      != GS_ALL_DONE)
-     return GS_ERROR;
+    return GS_ERROR;
 
-   gimplify_seq_add_stmt (pre_p, gimple_build_omp_atomic_load (tmp_load, addr));
+  loadstmt = gimple_build_omp_atomic_load (tmp_load, addr);
-   if (gimplify_expr (&rhs, pre_p, NULL, is_gimple_val, fb_rvalue)
+  gimplify_seq_add_stmt (pre_p, loadstmt);
-       != GS_ALL_DONE)
+  if (rhs && gimplify_expr (&rhs, pre_p, NULL, is_gimple_val, fb_rvalue)
-     return GS_ERROR;
+      != GS_ALL_DONE)
-   gimplify_seq_add_stmt (pre_p, gimple_build_omp_atomic_store (rhs));
+    return GS_ERROR;
-   *expr_p = NULL;
+
+  if (TREE_CODE (*expr_p) == OMP_ATOMIC_READ)
+    rhs = tmp_load;
+  storestmt = gimple_build_omp_atomic_store (rhs);
+  gimplify_seq_add_stmt (pre_p, storestmt);
+  switch (TREE_CODE (*expr_p))
+    {
+    case OMP_ATOMIC_READ:
+    case OMP_ATOMIC_CAPTURE_OLD:
+      *expr_p = tmp_load;
+      gimple_omp_atomic_set_need_value (loadstmt);
+      break;
+    case OMP_ATOMIC_CAPTURE_NEW:
+      *expr_p = rhs;
+      gimple_omp_atomic_set_need_value (storestmt);
+      break;
+    default:
+      *expr_p = NULL;
+      break;
+    }
 
    return GS_ALL_DONE;
 }
@@ -7230,6 +7255,9 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
 	  }
 
 	case OMP_ATOMIC:
+	case OMP_ATOMIC_READ:
+	case OMP_ATOMIC_CAPTURE_OLD:
+	case OMP_ATOMIC_CAPTURE_NEW:
 	  ret = gimplify_omp_atomic (expr_p, pre_p);
 	  break;
 

gcc/omp-builtins.def

@@ -37,6 +37,8 @@ DEF_GOMP_BUILTIN (BUILT_IN_GOMP_BARRIER, "GOMP_barrier",
 		  BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
 DEF_GOMP_BUILTIN (BUILT_IN_GOMP_TASKWAIT, "GOMP_taskwait",
 		  BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_GOMP_TASKYIELD, "GOMP_taskyield",
+		  BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
 DEF_GOMP_BUILTIN (BUILT_IN_GOMP_CRITICAL_START, "GOMP_critical_start",
 		  BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
 DEF_GOMP_BUILTIN (BUILT_IN_GOMP_CRITICAL_END, "GOMP_critical_end",

gcc/omp-low.c

@@ -1443,6 +1443,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
 	  ctx->default_kind = OMP_CLAUSE_DEFAULT_KIND (c);
 	  break;
 
+	case OMP_CLAUSE_FINAL:
 	case OMP_CLAUSE_IF:
 	case OMP_CLAUSE_NUM_THREADS:
 	case OMP_CLAUSE_SCHEDULE:
@@ -1454,6 +1455,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
 	case OMP_CLAUSE_ORDERED:
 	case OMP_CLAUSE_COLLAPSE:
 	case OMP_CLAUSE_UNTIED:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	default:
@@ -1504,6 +1506,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
 	case OMP_CLAUSE_ORDERED:
 	case OMP_CLAUSE_COLLAPSE:
 	case OMP_CLAUSE_UNTIED:
+	case OMP_CLAUSE_FINAL:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	default:
@@ -3081,7 +3085,7 @@ expand_parallel_call (struct omp_region *region, basic_block bb,
 static void
 expand_task_call (basic_block bb, gimple entry_stmt)
 {
-  tree t, t1, t2, t3, flags, cond, c, clauses;
+  tree t, t1, t2, t3, flags, cond, c, c2, clauses;
   gimple_stmt_iterator gsi;
   location_t loc = gimple_location (entry_stmt);
 
@@ -3094,7 +3098,19 @@ expand_task_call (basic_block bb, gimple entry_stmt)
     cond = boolean_true_node;
 
   c = find_omp_clause (clauses, OMP_CLAUSE_UNTIED);
-  flags = build_int_cst (unsigned_type_node, (c ? 1 : 0));
+  c2 = find_omp_clause (clauses, OMP_CLAUSE_MERGEABLE);
+  flags = build_int_cst (unsigned_type_node,
+			 (c ? 1 : 0) + (c2 ? 4 : 0));
+
+  c = find_omp_clause (clauses, OMP_CLAUSE_FINAL);
+  if (c)
+    {
+      c = gimple_boolify (OMP_CLAUSE_FINAL_EXPR (c));
+      c = fold_build3_loc (loc, COND_EXPR, unsigned_type_node, c,
+			   build_int_cst (unsigned_type_node, 2),
+			   build_int_cst (unsigned_type_node, 0));
+      flags = fold_build2_loc (loc, PLUS_EXPR, unsigned_type_node, flags, c);
+    }
 
   gsi = gsi_last_bb (bb);
   t = gimple_omp_task_data_arg (entry_stmt);
@@ -4944,6 +4960,31 @@ expand_omp_synch (struct omp_region *region)
     }
 }
 
+/* A subroutine of expand_omp_atomic.  Attempt to implement the atomic
+   operation as a normal volatile load.  */
+
+static bool
+expand_omp_atomic_load (basic_block load_bb, tree addr, tree loaded_val)
+{
+  /* FIXME */
+  (void) load_bb;
+  (void) addr;
+  (void) loaded_val;
+  return false;
+}
+
+/* A subroutine of expand_omp_atomic.  Attempt to implement the atomic
+   operation as a normal volatile store.  */
+
+static bool
+expand_omp_atomic_store (basic_block load_bb, tree addr)
+{
+  /* FIXME */
+  (void) load_bb;
+  (void) addr;
+  return false;
+}
+
 /* A subroutine of expand_omp_atomic.  Attempt to implement the atomic
    operation as a __sync_fetch_and_op builtin.  INDEX is log2 of the
    size of the data type, and thus usable to find the index of the builtin
@@ -4954,14 +4995,15 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
 			    tree addr, tree loaded_val,
 			    tree stored_val, int index)
 {
-  enum built_in_function base;
+  enum built_in_function oldbase, newbase;
   tree decl, itype, call;
-  direct_optab optab;
+  direct_optab optab, oldoptab, newoptab;
-  tree rhs;
+  tree lhs, rhs;
   basic_block store_bb = single_succ (load_bb);
   gimple_stmt_iterator gsi;
   gimple stmt;
   location_t loc;
+  bool need_old, need_new;
 
   /* We expect to find the following sequences:
 
@@ -4985,6 +5027,9 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
   gsi_next (&gsi);
   if (gimple_code (gsi_stmt (gsi)) != GIMPLE_OMP_ATOMIC_STORE)
     return false;
+  need_new = gimple_omp_atomic_need_value_p (gsi_stmt (gsi));
+  need_old = gimple_omp_atomic_need_value_p (last_stmt (load_bb));
+  gcc_checking_assert (!need_old || !need_new);
 
   if (!operand_equal_p (gimple_assign_lhs (stmt), stored_val, 0))
     return false;
@@ -4994,24 +5039,39 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
     {
     case PLUS_EXPR:
     case POINTER_PLUS_EXPR:
-      base = BUILT_IN_SYNC_FETCH_AND_ADD_N;
+      oldbase = BUILT_IN_SYNC_FETCH_AND_ADD_N;
+      newbase = BUILT_IN_SYNC_ADD_AND_FETCH_N;
       optab = sync_add_optab;
+      oldoptab = sync_old_add_optab;
+      newoptab = sync_new_add_optab;
       break;
     case MINUS_EXPR:
-      base = BUILT_IN_SYNC_FETCH_AND_SUB_N;
+      oldbase = BUILT_IN_SYNC_FETCH_AND_SUB_N;
+      newbase = BUILT_IN_SYNC_SUB_AND_FETCH_N;
       optab = sync_add_optab;
+      oldoptab = sync_old_add_optab;
+      newoptab = sync_new_add_optab;
       break;
     case BIT_AND_EXPR:
-      base = BUILT_IN_SYNC_FETCH_AND_AND_N;
+      oldbase = BUILT_IN_SYNC_FETCH_AND_AND_N;
+      newbase = BUILT_IN_SYNC_AND_AND_FETCH_N;
       optab = sync_and_optab;
+      oldoptab = sync_old_and_optab;
+      newoptab = sync_new_and_optab;
       break;
     case BIT_IOR_EXPR:
-      base = BUILT_IN_SYNC_FETCH_AND_OR_N;
+      oldbase = BUILT_IN_SYNC_FETCH_AND_OR_N;
+      newbase = BUILT_IN_SYNC_OR_AND_FETCH_N;
       optab = sync_ior_optab;
+      oldoptab = sync_old_ior_optab;
+      newoptab = sync_new_ior_optab;
       break;
     case BIT_XOR_EXPR:
-      base = BUILT_IN_SYNC_FETCH_AND_XOR_N;
+      oldbase = BUILT_IN_SYNC_FETCH_AND_XOR_N;
+      newbase = BUILT_IN_SYNC_XOR_AND_FETCH_N;
       optab = sync_xor_optab;
+      oldoptab = sync_old_xor_optab;
+      newoptab = sync_new_xor_optab;
       break;
     default:
       return false;
@@ -5025,20 +5085,49 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
   else
     return false;
 
-  decl = built_in_decls[base + index + 1];
+  decl = built_in_decls[(need_new ? newbase : oldbase) + index + 1];
   if (decl == NULL_TREE)
     return false;
   itype = TREE_TYPE (TREE_TYPE (decl));
 
-  if (direct_optab_handler (optab, TYPE_MODE (itype)) == CODE_FOR_nothing)
+  if (need_new)
+    {
+      /* expand_sync_fetch_operation can always compensate when interested
+	 in the new value.  */
+      if (direct_optab_handler (newoptab, TYPE_MODE (itype))
+	  == CODE_FOR_nothing
+	  && direct_optab_handler (oldoptab, TYPE_MODE (itype))
+	     == CODE_FOR_nothing)
+	return false;
+    }
+  else if (need_old)
+    {
+      /* When interested in the old value, expand_sync_fetch_operation
+	 can compensate only if the operation is reversible.  AND and OR
+	 are not reversible.  */
+      if (direct_optab_handler (oldoptab, TYPE_MODE (itype))
+	  == CODE_FOR_nothing
+	  && (oldbase == BUILT_IN_SYNC_FETCH_AND_AND_N
+	      || oldbase == BUILT_IN_SYNC_FETCH_AND_OR_N
+	      || direct_optab_handler (newoptab, TYPE_MODE (itype))
+		 == CODE_FOR_nothing))
+	return false;
+    }
+  else if (direct_optab_handler (optab, TYPE_MODE (itype)) == CODE_FOR_nothing)
     return false;
 
   gsi = gsi_last_bb (load_bb);
   gcc_assert (gimple_code (gsi_stmt (gsi)) == GIMPLE_OMP_ATOMIC_LOAD);
-  call = build_call_expr_loc (loc,
+  call = build_call_expr_loc (loc, decl, 2, addr,
-			  decl, 2, addr,
+			      fold_convert_loc (loc, itype, rhs));
-			  fold_convert_loc (loc, itype, rhs));
+  if (need_old || need_new)
-  call = fold_convert_loc (loc, void_type_node, call);
+    {
+      lhs = need_old ? loaded_val : stored_val;
+      call = fold_convert_loc (loc, TREE_TYPE (lhs), call);
+      call = build2_loc (loc, MODIFY_EXPR, void_type_node, lhs, call);
+    }
+  else
+    call = fold_convert_loc (loc, void_type_node, call);
   force_gimple_operand_gsi (&gsi, call, true, NULL_TREE, true, GSI_SAME_STMT);
   gsi_remove (&gsi, true);
 
@@ -5319,6 +5408,25 @@ expand_omp_atomic (struct omp_region *region)
       /* __sync builtins require strict data alignment.  */
       if (exact_log2 (align) >= index)
 	{
+	  /* Atomic load.  FIXME: have some target hook signalize what loads
+	     are actually atomic?  */
+	  if (loaded_val == stored_val
+	      && (GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT
+		  || GET_MODE_CLASS (TYPE_MODE (type)) == MODE_FLOAT)
+	      && GET_MODE_BITSIZE (TYPE_MODE (type)) <= BITS_PER_WORD
+	      && expand_omp_atomic_load (load_bb, addr, loaded_val))
+	    return;
+
+	  /* Atomic store.  FIXME: have some target hook signalize what
+	     stores are actually atomic?  */
+	  if ((GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT
+	       || GET_MODE_CLASS (TYPE_MODE (type)) == MODE_FLOAT)
+	      && GET_MODE_BITSIZE (TYPE_MODE (type)) <= BITS_PER_WORD
+	      && store_bb == single_succ (load_bb)
+	      && first_stmt (store_bb) == store
+	      && expand_omp_atomic_store (load_bb, addr))
+	    return;
+
 	  /* When possible, use specialized atomic update functions.  */
 	  if ((INTEGRAL_TYPE_P (type) || POINTER_TYPE_P (type))
 	      && store_bb == single_succ (load_bb))

gcc/testsuite/ChangeLog

@@ -1,3 +1,16 @@
+2011-08-02  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/46752
+	* gcc.dg/gomp/atomic-5.c: Adjust expected diagnostics.
+	* gcc.dg/gomp/atomic-15.c: New test.
+	* g++.dg/gomp/atomic-5.C: Adjust expected diagnostics.
+	* g++.dg/gomp/atomic-15.C: New test.
+	* g++.dg/gomp/private-1.C: New test.
+	* g++.dg/gomp/sharing-2.C: New test.
+	* gfortran.dg/gomp/crayptr1.f90: Don't expect error
+	about Cray pointer in FIRSTPRIVATE/LASTPRIVATE.
+	* gfortran.dg/gomp/omp_atomic2.f90: New test.
+
 2011-08-02  Tobias Burnus  <burnus@net-b.de>
 
 	* trim_optimize_5.f90: Remove spurious "use foo".

gcc/testsuite/g++.dg/gomp/atomic-15.C

@@ -0,0 +1,46 @@
+// { dg-do compile }
+// { dg-options "-fopenmp" }
+
+int x = 6;
+
+int
+main ()
+{
+  int v;
+  #pragma omp atomic
+    x = x * 7 + 6;	// { dg-error "expected" }
+  #pragma omp atomic
+    x = x * 7 ^ 6;	// { dg-error "expected" }
+  #pragma omp atomic update
+    x = x - 8 + 6;	// { dg-error "expected" }
+  #pragma omp atomic
+    x = x ^ 7 | 2;	// { dg-error "expected" }
+  #pragma omp atomic
+    x = x / 7 * 2;	// { dg-error "expected" }
+  #pragma omp atomic
+    x = x / 7 / 2;	// { dg-error "expected" }
+  #pragma omp atomic capture
+    v = x = x | 6;	// { dg-error "invalid operator" }
+  #pragma omp atomic capture
+    { v = x; x = x * 7 + 6; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { v = x; x = x * 7 ^ 6; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { v = x; x = x - 8 + 6; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { v = x; x = x ^ 7 | 2; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { v = x; x = x / 7 * 2; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { v = x; x = x / 7 / 2; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { x = x * 7 + 6; v = x; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { x = x * 7 ^ 6; v = x; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { x = x - 8 + 6; v = x; }	// { dg-error "expected" }
+  #pragma omp atomic capture
+    { x = x ^ 7 | 2; v = x; }	// { dg-error "expected" }
+  (void) v;
+  return 0;
+}

gcc/testsuite/g++.dg/gomp/atomic-5.C

@@ -9,9 +9,9 @@ void f1(void)
   #pragma omp atomic
     x %= 2;		/* { dg-error "invalid operator" } */
   #pragma omp atomic
-    x = x + 1;		/* { dg-error "invalid operator" } */
+    x = x + 1;
   #pragma omp atomic
-    x = 1;		/* { dg-error "invalid operator" } */
+    x = 1;		/* { dg-error "invalid form" } */
   #pragma omp atomic
     ++y;		/* { dg-error "read-only variable" } */
   #pragma omp atomic

gcc/testsuite/g++.dg/gomp/clause-3.C

@@ -84,7 +84,7 @@ foo (int x)
     ;
 #pragma omp p private (c) // { dg-error "predetermined 'shared'" }
     ;
-#pragma omp p firstprivate (c) // { dg-error "predetermined 'shared'" }
+#pragma omp p firstprivate (c)
     ;
 #pragma omp p for lastprivate (c) // { dg-error "predetermined 'shared'" }
   for (i = 0; i < 10; i++)

gcc/testsuite/g++.dg/gomp/private-1.C

@@ -0,0 +1,33 @@
+// { dg-do compile }
+// { dg-options "-fopenmp" }
+
+struct A { int i; A (); ~A (); };
+struct B { int i; };
+struct C { int i; mutable int j; C (); ~C (); };
+
+template <typename T> void bar (const T *);
+
+const A a;
+const C c;
+
+const A foo (const A d, const C e)
+{
+  const A f;
+  const B b = { 4 };
+  A g;
+  #pragma omp parallel private (a)	// { dg-error "predetermined" }
+    bar (&a);
+  #pragma omp parallel private (b)	// { dg-error "predetermined" }
+    bar (&b);
+  #pragma omp parallel private (c)
+    bar (&c);
+  #pragma omp parallel private (d)	// { dg-error "predetermined" }
+    bar (&d);
+  #pragma omp parallel private (e)
+    bar (&e);
+  #pragma omp parallel private (f)	// { dg-error "predetermined" }
+    bar (&f);
+  #pragma omp parallel private (g)
+    bar (&g);
+  return f;
+}

gcc/testsuite/g++.dg/gomp/sharing-2.C

@@ -0,0 +1,47 @@
+// { dg-do compile }
+
+struct T
+{
+  int i;
+  mutable int j;
+};
+struct S
+{
+  const static int d = 1;
+  const static T e;
+  void foo (int, T);
+};
+
+const int S::d;
+const T S::e = { 2, 3 };
+
+void bar (const int &);
+
+void
+S::foo (const int x, const T y)
+{
+  #pragma omp parallel firstprivate (x)
+    bar (x);
+  #pragma omp parallel firstprivate (d)
+    bar (d);
+  #pragma omp parallel firstprivate (y)
+    bar (y.i);
+  #pragma omp parallel firstprivate (e)	// { dg-error "is predetermined" }
+    bar (e.i);
+  #pragma omp parallel shared (x)	// { dg-error "is predetermined" }
+    bar (x);
+  #pragma omp parallel shared (d)	// { dg-error "is predetermined" }
+    bar (d);
+  #pragma omp parallel shared (e)	// { dg-error "is predetermined" }
+    bar (e.i);
+  #pragma omp parallel shared (y)
+    bar (y.i);
+  #pragma omp parallel private (x)	// { dg-error "is predetermined" }
+    bar (x);
+  #pragma omp parallel private (d)	// { dg-error "is predetermined" }
+    bar (d);
+  #pragma omp parallel private (y)
+    bar (y.i);
+  #pragma omp parallel private (e)	// { dg-error "is predetermined" }
+    bar (e.i);
+}

gcc/testsuite/gcc.dg/gomp/atomic-15.c

@@ -0,0 +1,46 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp" } */
+
+int x = 6;
+
+int
+main ()
+{
+  int v;
+  #pragma omp atomic
+    x = x * 7 + 6;	/* { dg-error "expected" } */
+  #pragma omp atomic
+    x = x * 7 ^ 6;	/* { dg-error "expected" } */
+  #pragma omp atomic update
+    x = x - 8 + 6;	/* { dg-error "expected" } */
+  #pragma omp atomic
+    x = x ^ 7 | 2;	/* { dg-error "expected" } */
+  #pragma omp atomic
+    x = x / 7 * 2;	/* { dg-error "expected" } */
+  #pragma omp atomic
+    x = x / 7 / 2;	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    v = x = x | 6;	/* { dg-error "invalid operator" } */
+  #pragma omp atomic capture
+    { v = x; x = x * 7 + 6; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { v = x; x = x * 7 ^ 6; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { v = x; x = x - 8 + 6; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { v = x; x = x ^ 7 | 2; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { v = x; x = x / 7 * 2; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { v = x; x = x / 7 / 2; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { x = x * 7 + 6; v = x; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { x = x * 7 ^ 6; v = x; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { x = x - 8 + 6; v = x; }	/* { dg-error "expected" } */
+  #pragma omp atomic capture
+    { x = x ^ 7 | 2; v = x; }	/* { dg-error "expected" } */
+  (void) v;
+  return 0;
+}

gcc/testsuite/gcc.dg/gomp/atomic-5.c

@@ -11,9 +11,9 @@ void f1(void)
   #pragma omp atomic
     x %= 2;		/* { dg-error "invalid operator" } */
   #pragma omp atomic
-    x = x + 1;		/* { dg-error "invalid operator" } */
+    x = x + 1;
   #pragma omp atomic
-    x = 1;		/* { dg-error "invalid operator" } */
+    x = 1;		/* { dg-error "invalid form" } */
   #pragma omp atomic
     ++y;		/* { dg-error "read-only variable" } */
   #pragma omp atomic

gcc/testsuite/gcc.dg/gomp/clause-1.c

@@ -84,7 +84,7 @@ foo (int x)
     ;
 #pragma omp p private (c) /* { dg-error "predetermined 'shared'" } */
     ;
-#pragma omp p firstprivate (c) /* { dg-error "predetermined 'shared'" } */
+#pragma omp p firstprivate (c)
     ;
 #pragma omp p for lastprivate (c) /* { dg-error "predetermined 'shared'" } */
   for (i = 0; i < 10; i++)

gcc/testsuite/gfortran.dg/gomp/crayptr1.f90

@@ -36,10 +36,10 @@
 !$omp end parallel
 
   ip3 = loc (i)
-!$omp parallel firstprivate (ip3) ! { dg-error "Cray pointer 'ip3' in FIRSTPRIVATE clause" }
+!$omp parallel firstprivate (ip3)
 !$omp end parallel
 
-!$omp parallel do lastprivate (ip4) ! { dg-error "Cray pointer 'ip4' in LASTPRIVATE clause" }
+!$omp parallel do lastprivate (ip4)
   do i = 1, 10
     if (i .eq. 10) ip4 = loc (i)
   end do

gcc/testsuite/gfortran.dg/gomp/omp_atomic2.f90

@@ -0,0 +1,54 @@
+  real :: r1, r2
+  complex :: c1, c2
+  integer :: i1, i2
+!$omp atomic write
+  c1 = 0
+!$omp atomic write
+  r2 = 0
+!$omp atomic write
+  i2 = 0
+!$omp atomic read
+  r1 = c1
+!$omp atomic read
+  c2 = r2
+!$omp atomic read
+  i1 = r2
+!$omp atomic read
+  c2 = i2
+!$omp atomic write
+  c1 = r1
+!$omp atomic write
+  r2 = c2
+!$omp atomic write
+  r2 = i1
+!$omp atomic write
+  i2 = c2
+!$omp end atomic
+!$omp atomic write
+  c1 = 1 + 2 + r1
+!$omp atomic write
+  r2 = c2 + 2 + 3
+!$omp atomic write
+  r2 = 3 + 4 + i1
+!$omp atomic write
+  i2 = c2 + 4 + 5
+!$omp atomic
+  c1 = c1 * 2.
+!$omp atomic update
+  r2 = r2 / 4
+!$omp end atomic
+!$omp atomic update
+  i2 = i2 + 8
+!$omp atomic capture
+  c1 = c1 * 2.
+  r1 = c1
+!$omp end atomic
+!$omp atomic capture
+  c2 = r2
+  r2 = r2 / 4
+!$omp end atomic
+!$omp atomic capture
+  i2 = i2 + 8
+  c2 = i2
+!$omp end atomic
+end

gcc/tree-nested.c

@@ -1097,6 +1097,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	  if (OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (clause) == NULL)
 	    break;
 	  /* FALLTHRU */
+	case OMP_CLAUSE_FINAL:
 	case OMP_CLAUSE_IF:
 	case OMP_CLAUSE_NUM_THREADS:
 	  wi->val_only = true;
@@ -1111,6 +1112,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_COPYIN:
 	case OMP_CLAUSE_COLLAPSE:
 	case OMP_CLAUSE_UNTIED:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	default:
@@ -1594,6 +1596,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	  if (OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (clause) == NULL)
 	    break;
 	  /* FALLTHRU */
+	case OMP_CLAUSE_FINAL:
 	case OMP_CLAUSE_IF:
 	case OMP_CLAUSE_NUM_THREADS:
 	  wi->val_only = true;
@@ -1608,6 +1611,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_COPYIN:
 	case OMP_CLAUSE_COLLAPSE:
 	case OMP_CLAUSE_UNTIED:
+	case OMP_CLAUSE_MERGEABLE:
 	  break;
 
 	default:

gcc/tree-pretty-print.c

@@ -421,6 +421,17 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
       pp_character (buffer, ')');
       break;
 
+    case OMP_CLAUSE_FINAL:
+      pp_string (buffer, "final(");
+      dump_generic_node (buffer, OMP_CLAUSE_FINAL_EXPR (clause),
+	  spc, flags, false);
+      pp_character (buffer, ')');
+      break;
+
+    case OMP_CLAUSE_MERGEABLE:
+      pp_string (buffer, "mergeable");
+      break;
+
     default:
       /* Should never happen.  */
       dump_generic_node (buffer, clause, spc, flags, false);
@@ -2208,6 +2219,24 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
       dump_generic_node (buffer, TREE_OPERAND (node, 1), spc, flags, false);
       break;
 
+    case OMP_ATOMIC_READ:
+      pp_string (buffer, "#pragma omp atomic read");
+      newline_and_indent (buffer, spc + 2);
+      dump_generic_node (buffer, TREE_OPERAND (node, 0), spc, flags, false);
+      pp_space (buffer);
+      break;
+
+    case OMP_ATOMIC_CAPTURE_OLD:
+    case OMP_ATOMIC_CAPTURE_NEW:
+      pp_string (buffer, "#pragma omp atomic capture");
+      newline_and_indent (buffer, spc + 2);
+      dump_generic_node (buffer, TREE_OPERAND (node, 0), spc, flags, false);
+      pp_space (buffer);
+      pp_character (buffer, '=');
+      pp_space (buffer);
+      dump_generic_node (buffer, TREE_OPERAND (node, 1), spc, flags, false);
+      break;
+
     case OMP_SINGLE:
       pp_string (buffer, "#pragma omp single");
       dump_omp_clauses (buffer, OMP_SINGLE_CLAUSES (node), spc, flags);

gcc/tree.c

@@ -247,7 +247,9 @@ unsigned const char omp_clause_num_ops[] =
   0, /* OMP_CLAUSE_ORDERED  */
   0, /* OMP_CLAUSE_DEFAULT  */
   3, /* OMP_CLAUSE_COLLAPSE  */
-  0  /* OMP_CLAUSE_UNTIED   */
+  0, /* OMP_CLAUSE_UNTIED   */
+  1, /* OMP_CLAUSE_FINAL  */
+  0  /* OMP_CLAUSE_MERGEABLE  */
 };
 
 const char * const omp_clause_code_name[] =
@@ -267,7 +269,9 @@ const char * const omp_clause_code_name[] =
   "ordered",
   "default",
   "collapse",
-  "untied"
+  "untied",
+  "final",
+  "mergeable"
 };
 
 
@@ -10546,6 +10550,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
 	case OMP_CLAUSE_FIRSTPRIVATE:
 	case OMP_CLAUSE_COPYIN:
 	case OMP_CLAUSE_COPYPRIVATE:
+	case OMP_CLAUSE_FINAL:
 	case OMP_CLAUSE_IF:
 	case OMP_CLAUSE_NUM_THREADS:
 	case OMP_CLAUSE_SCHEDULE:
@@ -10556,6 +10561,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
 	case OMP_CLAUSE_ORDERED:
 	case OMP_CLAUSE_DEFAULT:
 	case OMP_CLAUSE_UNTIED:
+	case OMP_CLAUSE_MERGEABLE:
 	  WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp));
 
 	case OMP_CLAUSE_LASTPRIVATE:

gcc/tree.def

@@ -1040,6 +1040,22 @@ DEFTREECODE (OMP_CRITICAL, "omp_critical", tcc_statement, 2)
 	build_fold_indirect_ref of the address.  */
 DEFTREECODE (OMP_ATOMIC, "omp_atomic", tcc_statement, 2)
 
+/* OpenMP - #pragma omp atomic read
+   Operand 0: The address at which the atomic operation is to be performed.
+	This address should be stabilized with save_expr.  */
+DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1)
+
+/* OpenMP - #pragma omp atomic capture
+   Operand 0: The address at which the atomic operation is to be performed.
+	This address should be stabilized with save_expr.
+   Operand 1: The expression to evaluate.  When the old value of the object
+	at the address is used in the expression, it should appear as if
+	build_fold_indirect_ref of the address.
+   OMP_ATOMIC_CAPTURE_OLD returns the old memory content,
+   OMP_ATOMIC_CAPTURE_NEW the new value.  */
+DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2)
+DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2)
+
 /* OpenMP clauses.  */
 DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0)
 

gcc/tree.h

@@ -403,7 +403,13 @@ enum omp_clause_code
   OMP_CLAUSE_COLLAPSE,
 
   /* OpenMP clause: untied.  */
-  OMP_CLAUSE_UNTIED
+  OMP_CLAUSE_UNTIED,
+
+  /* OpenMP clause: final (scalar-expression).  */
+  OMP_CLAUSE_FINAL,
+
+  /* OpenMP clause: mergeable.  */
+  OMP_CLAUSE_MERGEABLE
 };
 
 /* The definition of tree nodes fills the next several pages.  */
@@ -1879,6 +1885,8 @@ extern void protected_set_expr_location (tree, location_t);
 #define OMP_CLAUSE_LASTPRIVATE_GIMPLE_SEQ(NODE) \
   (OMP_CLAUSE_CHECK (NODE))->omp_clause.gimple_reduction_init
 
+#define OMP_CLAUSE_FINAL_EXPR(NODE) \
+  OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_FINAL), 0)
 #define OMP_CLAUSE_IF_EXPR(NODE) \
   OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_IF), 0)
 #define OMP_CLAUSE_NUM_THREADS_EXPR(NODE) \

libgomp/ChangeLog

@@ -1,3 +1,74 @@
+2011-08-02  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/42041
+	PR fortran/46752
+	* omp.h.in (omp_in_final): New prototype.
+	* omp_lib.f90.in (omp_in_final): New interface.
+	(omp_integer_kind, omp_logical_kind): Remove
+	and replace all its uses in the module with 4.
+	(openmp_version): Change to 201107.
+	* omp_lib.h.in (omp_sched_static, omp_sched_dynamic,
+	omp_sched_guided, omp_sched_auto): Use omp_sched_kind
+	kind for the parameters.
+	(omp_in_final): New external.
+	(openmp_version): Change to 201107.
+	* task.c (omp_in_final): New function.
+	(gomp_init_task): Initialize final_task.
+	(GOMP_task): Remove unused attribute from flags.  Handle final
+	tasks.
+	(GOMP_taskyield): New function.
+	(omp_in_final): Return true if if (false) or final (true) task
+	or descendant of final (true).
+	* fortran.c (omp_in_final_): New function.
+	* libgomp.map (OMP_3.1): Export omp_in_final and omp_in_final_.
+	(GOMP_3.0): Export GOMP_taskyield.
+	* env.c (gomp_nthreads_var_list, gomp_nthreads_var_list_len): New
+	variables.
+	(parse_unsigned_long_list): New function.
+	(initialize_env): Use it for OMP_NUM_THREADS.  Call parse_boolean
+	with "OMP_PROC_BIND".  If OMP_PROC_BIND=true, call gomp_init_affinity
+	even if parse_affinity returned false.
+	* config/linux/affinity.c (gomp_init_affinity): Handle
+	gomp_cpu_affinity_len == 0.
+	* libgomp_g.h (GOMP_taskyield): New prototype.
+	* libgomp.h (struct gomp_task): Add final_task field.
+	(gomp_nthreads_var_list, gomp_nthreads_var_list_len): New externs.
+	* team.c (gomp_team_start): Override new task's nthreads_var icv
+	if list form OMP_NUM_THREADS has been used and it has value for
+	the new nesting level.
+
+	* testsuite/libgomp.c/atomic-11.c: New test.
+	* testsuite/libgomp.c/atomic-12.c: New test.
+	* testsuite/libgomp.c/atomic-13.c: New test.
+	* testsuite/libgomp.c/atomic-14.c: New test.
+	* testsuite/libgomp.c/reduction-6.c: New test.
+	* testsuite/libgomp.c/task-5.c: New test.
+	* testsuite/libgomp.c++/atomic-2.C: New test.
+	* testsuite/libgomp.c++/atomic-3.C: New test.
+	* testsuite/libgomp.c++/atomic-4.C: New test.
+	* testsuite/libgomp.c++/atomic-5.C: New test.
+	* testsuite/libgomp.c++/atomic-6.C: New test.
+	* testsuite/libgomp.c++/atomic-7.C: New test.
+	* testsuite/libgomp.c++/atomic-8.C: New test.
+	* testsuite/libgomp.c++/atomic-9.C: New test.
+	* testsuite/libgomp.c++/task-8.C: New test.
+	* testsuite/libgomp.c++/reduction-4.C: New test.
+	* testsuite/libgomp.fortran/allocatable7.f90: New test.
+	* testsuite/libgomp.fortran/allocatable8.f90: New test.
+	* testsuite/libgomp.fortran/crayptr3.f90: New test.
+	* testsuite/libgomp.fortran/omp_atomic3.f90: New test.
+	* testsuite/libgomp.fortran/omp_atomic4.f90: New test.
+	* testsuite/libgomp.fortran/pointer1.f90: New test.
+	* testsuite/libgomp.fortran/pointer2.f90: New test.
+	* testsuite/libgomp.fortran/task4.f90: New test.
+
+2011-08-02  Tobias Burnus  <burnus@net-b.de>
+
+	* libgomp.texi: Update OpenMP spec references to 3.1.
+	(omp_in_final,OMP_PROC_BIND): New sections.
+	(OMP_NUM_THREADS): Document that the value can be now a list.
+	(GOMP_STACKSIZE,GOMP_CPU_AFFINITY): Update @ref.
+
 2011-08-02  H.J. Lu  <hongjiu.lu@intel.com>
 
 	* config/linux/x86/futex.h: Check __x86_64__ instead of

libgomp/config/linux/affinity.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
+   Free Software Foundation, Inc.
    Contributed by Jakub Jelinek <jakub@redhat.com>.
 
    This file is part of the GNU OpenMP Library (libgomp).
@@ -53,17 +54,36 @@ gomp_init_affinity (void)
     }
 
   CPU_ZERO (&cpusetnew);
-  for (widx = idx = 0; idx < gomp_cpu_affinity_len; idx++)
+  if (gomp_cpu_affinity_len == 0)
-    if (gomp_cpu_affinity[idx] < CPU_SETSIZE
+    {
-        && CPU_ISSET (gomp_cpu_affinity[idx], &cpuset))
+      unsigned long count = CPU_COUNT (&cpuset);
-      {
+      if (count >= 65536)
-	if (! CPU_ISSET (gomp_cpu_affinity[idx], &cpusetnew))
+	count = 65536;
+      gomp_cpu_affinity = malloc (count * sizeof (unsigned short));
+      if (gomp_cpu_affinity == NULL)
+	{
+	  gomp_error ("not enough memory to store CPU affinity list");
+	  return;
+	}
+      for (widx = idx = 0; widx < count && idx < 65536; idx++)
+	if (CPU_ISSET (idx, &cpuset))
 	  {
 	    cpus++;
-	    CPU_SET (gomp_cpu_affinity[idx], &cpusetnew);
+	    gomp_cpu_affinity[widx++] = idx;
 	  }
-	gomp_cpu_affinity[widx++] = gomp_cpu_affinity[idx];
+    }
-      }
+  else
+    for (widx = idx = 0; idx < gomp_cpu_affinity_len; idx++)
+      if (gomp_cpu_affinity[idx] < CPU_SETSIZE
+	  && CPU_ISSET (gomp_cpu_affinity[idx], &cpuset))
+	{
+	  if (! CPU_ISSET (gomp_cpu_affinity[idx], &cpusetnew))
+	    {
+	      cpus++;
+	      CPU_SET (gomp_cpu_affinity[idx], &cpusetnew);
+	    }
+	  gomp_cpu_affinity[widx++] = gomp_cpu_affinity[idx];
+	}
 
   if (widx == 0)
     {

libgomp/env.c

@@ -67,6 +67,7 @@ gomp_mutex_t gomp_remaining_threads_lock;
 #endif
 unsigned long gomp_available_cpus = 1, gomp_managed_threads = 1;
 unsigned long long gomp_spin_count_var, gomp_throttled_spin_count_var;
+unsigned long *gomp_nthreads_var_list, gomp_nthreads_var_list_len;
 
 /* Parse the OMP_SCHEDULE environment variable.  */
 
@@ -184,6 +185,95 @@ parse_unsigned_long (const char *name, unsigned long *pvalue, bool allow_zero)
   return false;
 }
 
+/* Parse an unsigned long list environment variable.  Return true if one was
+   present and it was successfully parsed.  */
+
+static bool
+parse_unsigned_long_list (const char *name, unsigned long *p1stvalue,
+			  unsigned long **pvalues,
+			  unsigned long *pnvalues)
+{
+  char *env, *end;
+  unsigned long value, *values = NULL;
+
+  env = getenv (name);
+  if (env == NULL)
+    return false;
+
+  while (isspace ((unsigned char) *env))
+    ++env;
+  if (*env == '\0')
+    goto invalid;
+
+  errno = 0;
+  value = strtoul (env, &end, 10);
+  if (errno || (long) value <= 0)
+    goto invalid;
+
+  while (isspace ((unsigned char) *end))
+    ++end;
+  if (*end != '\0')
+    {
+      if (*end == ',')
+	{
+	  unsigned long nvalues = 0, nalloced = 0;
+
+	  do
+	    {
+	      env = end + 1;
+	      if (nvalues == nalloced)
+		{
+		  unsigned long *n;
+		  nalloced = nalloced ? nalloced * 2 : 16;
+		  n = realloc (values, nalloced * sizeof (unsigned long));
+		  if (n == NULL)
+		    {
+		      free (values);
+		      gomp_error ("Out of memory while trying to parse"
+				  " environment variable %s", name);
+		      return false;
+		    }
+		  values = n;
+		  if (nvalues == 0)
+		    values[nvalues++] = value;
+		}
+
+	      while (isspace ((unsigned char) *env))
+		++env;
+	      if (*env == '\0')
+		goto invalid;
+
+	      errno = 0;
+	      value = strtoul (env, &end, 10);
+	      if (errno || (long) value <= 0)
+		goto invalid;
+
+	      values[nvalues++] = value;
+	      while (isspace ((unsigned char) *end))
+		++end;
+	      if (*end == '\0')
+		break;
+	      if (*end != ',')
+		goto invalid;
+	    }
+	  while (1);
+	  *p1stvalue = values[0];
+	  *pvalues = values;
+	  *pnvalues = nvalues;
+	  return true;
+	}
+      goto invalid;
+    }
+
+  *p1stvalue = value;
+  return true;
+
+ invalid:
+  free (values);
+  gomp_error ("Invalid value for environment variable %s", name);
+  return false;
+}
+
 /* Parse the OMP_STACKSIZE environment varible.  Return true if one was
    present and it was successfully parsed.  */
 
@@ -481,6 +571,7 @@ initialize_env (void)
 {
   unsigned long stacksize;
   int wait_policy;
+  bool bind_var = false;
 
   /* Do a compile time check that mkomp_h.pl did good job.  */
   omp_check_defines ();
@@ -488,6 +579,7 @@ initialize_env (void)
   parse_schedule ();
   parse_boolean ("OMP_DYNAMIC", &gomp_global_icv.dyn_var);
   parse_boolean ("OMP_NESTED", &gomp_global_icv.nest_var);
+  parse_boolean ("OMP_PROC_BIND", &bind_var);
   parse_unsigned_long ("OMP_MAX_ACTIVE_LEVELS", &gomp_max_active_levels_var,
 		       true);
   parse_unsigned_long ("OMP_THREAD_LIMIT", &gomp_thread_limit_var, false);
@@ -498,10 +590,12 @@ initialize_env (void)
 #endif
   gomp_init_num_threads ();
   gomp_available_cpus = gomp_global_icv.nthreads_var;
-  if (!parse_unsigned_long ("OMP_NUM_THREADS", &gomp_global_icv.nthreads_var,
+  if (!parse_unsigned_long_list ("OMP_NUM_THREADS",
-			    false))
+				 &gomp_global_icv.nthreads_var,
+				 &gomp_nthreads_var_list,
+				 &gomp_nthreads_var_list_len))
     gomp_global_icv.nthreads_var = gomp_available_cpus;
-  if (parse_affinity ())
+  if (parse_affinity () || bind_var)
     gomp_init_affinity ();
   wait_policy = parse_wait_policy ();
   if (!parse_spincount ("GOMP_SPINCOUNT", &gomp_spin_count_var))

libgomp/fortran.c

@@ -69,6 +69,7 @@ ialias_redirect (omp_get_level)
 ialias_redirect (omp_get_ancestor_thread_num)
 ialias_redirect (omp_get_team_size)
 ialias_redirect (omp_get_active_level)
+ialias_redirect (omp_in_final)
 #endif
 
 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
@@ -428,3 +429,9 @@ omp_get_active_level_ (void)
 {
   return omp_get_active_level ();
 }
+
+int32_t
+omp_in_final_ (void)
+{
+  return omp_in_final ();
+}

libgomp/libgomp.h

@@ -1,4 +1,5 @@
-/* Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011
+   Free Software Foundation, Inc.
    Contributed by Richard Henderson <rth@redhat.com>.
 
    This file is part of the GNU OpenMP Library (libgomp).
@@ -226,6 +227,7 @@ extern gomp_mutex_t gomp_remaining_threads_lock;
 extern unsigned long gomp_max_active_levels_var;
 extern unsigned long long gomp_spin_count_var, gomp_throttled_spin_count_var;
 extern unsigned long gomp_available_cpus, gomp_managed_threads;
+extern unsigned long *gomp_nthreads_var_list, gomp_nthreads_var_list_len;
 
 enum gomp_task_kind
 {
@@ -251,6 +253,7 @@ struct gomp_task
   enum gomp_task_kind kind;
   bool in_taskwait;
   bool in_tied_task;
+  bool final_task;
   gomp_sem_t taskwait_sem;
 };
 

libgomp/libgomp.map

@@ -107,6 +107,12 @@ OMP_3.0 {
 	omp_unset_nest_lock_;
 } OMP_2.0;
 
+OMP_3.1 {
+  global:
+	omp_in_final;
+	omp_in_final_;
+} OMP_3.0;
+
 GOMP_1.0 {
   global:
 	GOMP_atomic_end;
@@ -173,3 +179,8 @@ GOMP_2.0 {
 	GOMP_loop_ull_static_next;
 	GOMP_loop_ull_static_start;
 } GOMP_1.0;
+
+GOMP_3.0 {
+  global:
+	GOMP_taskyield;
+} GOMP_2.0;

libgomp/libgomp.texi

@@ -116,7 +116,7 @@ arranges for automatic linking of the OpenMP runtime library
 
 A complete description of all OpenMP directives accepted may be found in 
 the @uref{http://www.openmp.org, OpenMP Application Program Interface} manual,
-version 3.0.
+version 3.1.
 
 
 @c ---------------------------------------------------------------------
@@ -127,7 +127,7 @@ version 3.0.
 @chapter Runtime Library Routines
 
 The runtime routines described here are defined by section 3 of the OpenMP 
-specifications in version 3.0. The routines are structured in following
+specifications in version 3.1. The routines are structured in following
 three parts:
 
 Control threads, processors and the parallel environment.
@@ -147,6 +147,7 @@ Control threads, processors and the parallel environment.
 * omp_get_thread_limit::        Maximum number of threads
 * omp_get_thread_num::          Current thread ID
 * omp_in_parallel::             Whether a parallel region is active
+* omp_in_final::                Whether in final or included task region
 * omp_set_dynamic::             Enable/disable dynamic teams
 * omp_set_max_active_levels::   Limits the number of active parallel regions
 * omp_set_nested::              Enable/disable nested parallel regions
@@ -199,7 +200,7 @@ which enclose the calling call.
 @ref{omp_get_level}, @ref{omp_get_max_active_levels}, @ref{omp_set_max_active_levels}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.19.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.19.
 @end table
 
 
@@ -228,7 +229,7 @@ zero to @code{omp_get_level} -1 is returned; if @var{level} is
 @ref{omp_get_level}, @ref{omp_get_thread_num}, @ref{omp_get_team_size}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.17.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.17.
 @end table
 
 
@@ -260,7 +261,7 @@ disabled by default.
 @ref{omp_set_dynamic}, @ref{OMP_DYNAMIC}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.8.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.8.
 @end table
 
 
@@ -286,7 +287,7 @@ which enclose the calling call.
 @ref{omp_get_active_level}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.16.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.16.
 @end table
 
 
@@ -311,7 +312,7 @@ This function obtains the maximum allowed number of nested, active parallel regi
 @ref{omp_set_max_active_levels}, @ref{omp_get_active_level}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.14.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.15.
 @end table
 
 
@@ -337,7 +338,7 @@ that does not use the clause @code{num_threads}.
 @ref{omp_set_num_threads}, @ref{omp_set_dynamic}, @ref{omp_get_thread_limit}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.3.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.3.
 @end table
 
 
@@ -369,7 +370,7 @@ disabled by default.
 @ref{omp_set_nested}, @ref{OMP_NESTED}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.10.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.10.
 @end table
 
 
@@ -391,7 +392,7 @@ Returns the number of processors online.
 @end multitable
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.5.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.5.
 @end table
 
 
@@ -424,7 +425,7 @@ one thread per CPU online is used.
 @ref{omp_get_max_threads}, @ref{omp_set_num_threads}, @ref{OMP_NUM_THREADS}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.2.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.2.
 @end table
 
 
@@ -440,7 +441,7 @@ set to the value @code{omp_sched_static}, @code{omp_sched_dynamic},
 
 @item @emph{C/C++}
 @multitable @columnfractions .20 .80
-@item @emph{Prototype}: @tab @code{omp_schedule(omp_sched_t *kind, int *modifier);}
+@item @emph{Prototype}: @tab @code{void omp_schedule(omp_sched_t *kind, int *modifier);}
 @end multitable
 
 @item @emph{Fortran}:
@@ -454,7 +455,7 @@ set to the value @code{omp_sched_static}, @code{omp_sched_dynamic},
 @ref{omp_set_schedule}, @ref{OMP_SCHEDULE}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.12.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.12.
 @end table
 
 
@@ -484,7 +485,7 @@ to @code{omp_get_num_threads}.
 @ref{omp_get_num_threads}, @ref{omp_get_level}, @ref{omp_get_ancestor_thread_num}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.18.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.18.
 @end table
 
 
@@ -509,7 +510,7 @@ Return the maximum number of threads of the program.
 @ref{omp_get_max_threads}, @ref{OMP_THREAD_LIMIT}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.13.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.13.
 @end table
 
 
@@ -538,7 +539,7 @@ value of the master thread of a team is always 0.
 @ref{omp_get_num_threads}, @ref{omp_get_ancestor_thread_num}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.4.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.4.
 @end table
 
 
@@ -562,7 +563,30 @@ their language-specific counterparts.
 @end multitable
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.6.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.6.
+@end table
+
+
+@node omp_in_final
+@section @code{omp_in_final} -- Whether in final or included task region
+@table @asis
+@item @emph{Description}:
+This function returns @code{true} if currently running in a final
+or included task region, @code{false} otherwise. Here, @code{true}
+and @code{false} represent their language-specific counterparts.
+
+@item @emph{C/C++}:
+@multitable @columnfractions .20 .80
+@item @emph{Prototype}: @tab @code{int omp_in_final(void);}
+@end multitable
+
+@item @emph{Fortran}:
+@multitable @columnfractions .20 .80
+@item @emph{Interface}: @tab @code{logical function omp_in_final()}
+@end multitable
+
+@item @emph{Reference}:
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.20.
 @end table
 
 
@@ -590,7 +614,7 @@ adjustment of team sizes and @code{false} disables it.
 @ref{OMP_DYNAMIC}, @ref{omp_get_dynamic}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.7.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.7.
 @end table
 
 
@@ -617,7 +641,7 @@ parallel regions.
 @ref{omp_get_max_active_levels}, @ref{omp_get_active_level}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.14.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.14.
 @end table
 
 
@@ -646,7 +670,7 @@ dynamic adjustment of team sizes and @code{false} disables it.
 @ref{OMP_NESTED}, @ref{omp_get_nested}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.9.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.9.
 @end table
 
 
@@ -674,7 +698,7 @@ argument of @code{omp_set_num_threads} shall be a positive integer.
 @ref{OMP_NUM_THREADS}, @ref{omp_get_num_threads}, @ref{omp_get_max_threads}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.1.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.1.
 @end table
 
 
@@ -692,7 +716,7 @@ For @code{omp_sched_auto} the @var{modifier} argument is ignored.
 
 @item @emph{C/C++}
 @multitable @columnfractions .20 .80
-@item @emph{Prototype}: @tab @code{int omp_set_schedule(omp_sched_t *kind, int *modifier);}
+@item @emph{Prototype}: @tab @code{void omp_set_schedule(omp_sched_t *kind, int *modifier);}
 @end multitable
 
 @item @emph{Fortran}:
@@ -707,7 +731,7 @@ For @code{omp_sched_auto} the @var{modifier} argument is ignored.
 @ref{OMP_SCHEDULE}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.11.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.11.
 @end table
 
 
@@ -734,7 +758,7 @@ an unlocked state.
 @ref{omp_destroy_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.1.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.1.
 @end table
 
 
@@ -763,7 +787,7 @@ a deadlock occurs.
 @ref{omp_init_lock}, @ref{omp_test_lock}, @ref{omp_unset_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.3.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.3.
 @end table
 
 
@@ -785,8 +809,7 @@ does not block if the lock is not available. This function returns
 
 @item @emph{Fortran}:
 @multitable @columnfractions .20 .80
-@item @emph{Interface}: @tab @code{subroutine omp_test_lock(lock)}
+@item @emph{Interface}: @tab @code{logical function omp_test_lock(lock)}
-@item                   @tab @code{logical(omp_logical_kind) :: omp_test_lock}
 @item                   @tab @code{integer(omp_lock_kind), intent(inout) :: lock}
 @end multitable
 
@@ -794,7 +817,7 @@ does not block if the lock is not available. This function returns
 @ref{omp_init_lock}, @ref{omp_set_lock}, @ref{omp_set_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.5.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.5.
 @end table
 
 
@@ -807,7 +830,7 @@ A simple lock about to be unset must have been locked by @code{omp_set_lock}
 or @code{omp_test_lock} before. In addition, the lock must be held by the 
 thread calling @code{omp_unset_lock}. Then, the lock becomes unlocked. If one 
 or more threads attempted to set the lock before, one of them is chosen to, 
-again, set the lock for itself.
+again, set the lock to itself.
 
 @item @emph{C/C++}:
 @multitable @columnfractions .20 .80
@@ -824,7 +847,7 @@ again, set the lock for itself.
 @ref{omp_set_lock}, @ref{omp_test_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.4.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.4.
 @end table
 
 
@@ -851,7 +874,7 @@ in the unlocked state.
 @ref{omp_init_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.2.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.2.
 @end table
 
 
@@ -878,7 +901,7 @@ an unlocked state and the nesting count is set to zero.
 @ref{omp_destroy_nest_lock}
 
 @item @emph{Reference}:
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.1.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.1.
 @end table
 
 
@@ -889,7 +912,7 @@ an unlocked state and the nesting count is set to zero.
 Before setting a nested lock, the lock variable must be initialized by 
 @code{omp_init_nest_lock}. The calling thread is blocked until the lock 
 is available. If the lock is already held by the current thread, the 
-nesting count for the lock in incremented.
+nesting count for the lock is incremented.
 
 @item @emph{C/C++}:
 @multitable @columnfractions .20 .80
@@ -906,7 +929,7 @@ nesting count for the lock in incremented.
 @ref{omp_init_nest_lock}, @ref{omp_unset_nest_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.3.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.3.
 @end table
 
 
@@ -928,8 +951,7 @@ is returned. Otherwise, the return value equals zero.
 
 @item @emph{Fortran}:
 @multitable @columnfractions .20 .80
-@item @emph{Interface}: @tab @code{integer function omp_test_nest_lock(lock)}
+@item @emph{Interface}: @tab @code{logical function omp_test_nest_lock(lock)}
-@item                   @tab @code{integer(omp_integer_kind) :: omp_test_nest_lock}
 @item                   @tab @code{integer(omp_nest_lock_kind), intent(inout) :: lock}
 @end multitable
 
@@ -938,7 +960,7 @@ is returned. Otherwise, the return value equals zero.
 @ref{omp_init_lock}, @ref{omp_set_lock}, @ref{omp_set_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.5.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.5.
 @end table
 
 
@@ -951,7 +973,7 @@ A nested lock about to be unset must have been locked by @code{omp_set_nested_lo
 or @code{omp_test_nested_lock} before. In addition, the lock must be held by the 
 thread calling @code{omp_unset_nested_lock}. If the nesting count drops to zero, the 
 lock becomes unlocked. If one ore more threads attempted to set the lock before, 
-one of them is chosen to, again, set the lock for itself.
+one of them is chosen to, again, set the lock to itself.
 
 @item @emph{C/C++}:
 @multitable @columnfractions .20 .80
@@ -968,7 +990,7 @@ one of them is chosen to, again, set the lock for itself.
 @ref{omp_set_nest_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.4.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.4.
 @end table
 
 
@@ -995,7 +1017,7 @@ in the unlocked state and its nesting count must equal zero.
 @ref{omp_init_lock}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.2.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.2.
 @end table
 
 
@@ -1021,7 +1043,7 @@ successive clock ticks.
 @ref{omp_get_wtime}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.4.2.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.4.2.
 @end table
 
 
@@ -1049,7 +1071,7 @@ guaranteed not to change during the execution of the program.
 @ref{omp_get_wtick}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.4.1.
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.4.1.
 @end table
 
 
@@ -1064,7 +1086,7 @@ guaranteed not to change during the execution of the program.
 The variables @env{OMP_DYNAMIC}, @env{OMP_MAX_ACTIVE_LEVELS},
 @env{OMP_NESTED}, @env{OMP_NUM_THREADS}, @env{OMP_SCHEDULE},
 @env{OMP_STACKSIZE},@env{OMP_THREAD_LIMIT} and @env{OMP_WAIT_POLICY}
-are defined by section 4 of the OpenMP specifications in version 3.0,
+are defined by section 4 of the OpenMP specifications in version 3.1,
 while @env{GOMP_CPU_AFFINITY} and @env{GOMP_STACKSIZE} are GNU 
 extensions.
 
@@ -1077,6 +1099,7 @@ extensions.
 * OMP_SCHEDULE::          How threads are scheduled
 * OMP_THREAD_LIMIT::      Set the maximum number of threads
 * OMP_WAIT_POLICY::       How waiting threads are handled
+* OMP_PROC_BIND::         Whether theads may be moved between CPUs
 * GOMP_CPU_AFFINITY::     Bind threads to specific CPUs
 * GOMP_STACKSIZE::        Set default thread stack size
 @end menu
@@ -1096,7 +1119,7 @@ disabled by default.
 @ref{omp_set_dynamic}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.3
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.3
 @end table
 
 
@@ -1107,14 +1130,14 @@ disabled by default.
 @table @asis
 @item @emph{Description}:
 Specifies the initial value for the maximum number of nested parallel
-regions. The value of this variable shall be positive integer.
+regions. The value of this variable shall be a positive integer.
 If undefined, the number of active levels is unlimited.
 
 @item @emph{See also}:
 @ref{omp_set_max_active_levels}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.7
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.8
 @end table
 
 
@@ -1134,7 +1157,7 @@ regions are disabled by default.
 @ref{omp_set_nested}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.4
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.5
 @end table
 
 
@@ -1146,14 +1169,15 @@ regions are disabled by default.
 @table @asis
 @item @emph{Description}:
 Specifies the default number of threads to use in parallel regions. The 
-value of this variable shall be a positive integer. If undefined one thread 
+value of this variable shall be a comma-separated list of positive integers;
-per CPU is used.
+the value specified the number of threads to use for the corresponding nested
+level. If undefined one thread per CPU is used.
 
 @item @emph{See also}:
 @ref{omp_set_num_threads}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.2
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.2
 @end table
 
 
@@ -1174,7 +1198,7 @@ dynamic scheduling and a chunk size of 1 is used.
 @ref{omp_set_schedule}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, sections 2.5.1 and 4.1
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 2.5.1 and 4.1
 @end table
 
 
@@ -1188,13 +1212,13 @@ Set the default thread stack size in kilobytes, unless the number
 is suffixed by @code{B}, @code{K}, @code{M} or @code{G}, in which
 case the size is, respectively, in bytes, kilobytes, megabytes
 or gigabytes. This is different from @code{pthread_attr_setstacksize}
-which gets the number of bytes as an argument. If the stacksize cannot
+which gets the number of bytes as an argument. If the stack size cannot
 be set due to system constraints, an error is reported and the initial
-stacksize is left unchanged. If undefined, the stack size is system
+stack size is left unchanged. If undefined, the stack size is system
 dependent.
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, sections 4.5
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 4.6
 @end table
 
 
@@ -1213,7 +1237,7 @@ the number of threads is not limited.
 @ref{omp_get_thread_limit}
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.8
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.9
 @end table
 
 
@@ -1229,7 +1253,25 @@ power while waiting; while the value is @code{ACTIVE} specifies that
 they should.
 
 @item @emph{Reference}: 
-@uref{http://www.openmp.org/, OpenMP specifications v3.0}, sections 4.6
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 4.7
+@end table
+
+
+
+@node OMP_PROC_BIND
+@section @env{OMP_PROC_BIND} -- Whether theads may be moved between CPUs
+@cindex Environment Variable
+@table @asis
+@item @emph{Description}:
+Specifies whether threads may be moved between processors. If set to
+@code{true}, OpenMP theads should not be moved, if set to @code{false}
+they may be moved.
+
+@item @emph{See also}:
+@ref{GOMP_CPU_AFFINITY}
+
+@item @emph{Reference}: 
+@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 4.4
 @end table
 
 
@@ -1258,6 +1300,9 @@ or disabled during the runtime of the application.
 
 If this environment variable is omitted, the host system will handle the 
 assignment of threads to CPUs. 
+
+@item @emph{See also}:
+@ref{OMP_PROC_BIND}
 @end table
 
 
@@ -1270,8 +1315,8 @@ assignment of threads to CPUs.
 @item @emph{Description}:
 Set the default thread stack size in kilobytes. This is different from
 @code{pthread_attr_setstacksize} which gets the number of bytes as an 
-argument. If the stacksize cannot be set due to system constraints, an 
+argument. If the stack size cannot be set due to system constraints, an 
-error is reported and the initial stacksize is left unchanged. If undefined,
+error is reported and the initial stack size is left unchanged. If undefined,
 the stack size is system dependent.
 
 @item @emph{See also}:

libgomp/libgomp_g.h

@@ -158,11 +158,12 @@ extern void GOMP_ordered_end (void);
 extern void GOMP_parallel_start (void (*) (void *), void *, unsigned);
 extern void GOMP_parallel_end (void);
 
-/* team.c */
+/* task.c */
 
 extern void GOMP_task (void (*) (void *), void *, void (*) (void *, void *),
 		       long, long, bool, unsigned);
 extern void GOMP_taskwait (void);
+extern void GOMP_taskyield (void);
 
 /* sections.c */
 

libgomp/omp.h.in

@@ -1,4 +1,4 @@
-/* Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2005, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
    Contributed by Richard Henderson <rth@redhat.com>.
 
    This file is part of the GNU OpenMP Library (libgomp).
@@ -98,6 +98,8 @@ int omp_get_ancestor_thread_num (int) __GOMP_NOTHROW;
 int omp_get_team_size (int) __GOMP_NOTHROW;
 int omp_get_active_level (void) __GOMP_NOTHROW;
 
+int omp_in_final (void) __GOMP_NOTHROW;
+
 #ifdef __cplusplus
 }
 #endif

libgomp/omp_lib.f90.in

@@ -1,4 +1,4 @@
-!  Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
+!  Copyright (C) 2005, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
 !  Contributed by Jakub Jelinek <jakub@redhat.com>.
 
 !  This file is part of the GNU OpenMP Library (libgomp).
@@ -24,8 +24,6 @@
 
       module omp_lib_kinds
         implicit none
-        integer, parameter :: omp_integer_kind = 4
-        integer, parameter :: omp_logical_kind = 4
         integer, parameter :: omp_lock_kind = @OMP_LOCK_KIND@
         integer, parameter :: omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@
         integer, parameter :: omp_sched_kind = 4
@@ -34,7 +32,7 @@
       module omp_lib
         use omp_lib_kinds
         implicit none
-        integer, parameter :: openmp_version = 200805
+        integer, parameter :: openmp_version = 201107
         integer (omp_sched_kind), parameter :: omp_sched_static = 1
         integer (omp_sched_kind), parameter :: omp_sched_dynamic = 2
         integer (omp_sched_kind), parameter :: omp_sched_guided = 3
@@ -126,28 +124,28 @@
         interface
           function omp_get_dynamic ()
             use omp_lib_kinds
-            logical (omp_logical_kind) :: omp_get_dynamic
+            logical (4) :: omp_get_dynamic
           end function omp_get_dynamic
         end interface
 
         interface
           function omp_get_nested ()
             use omp_lib_kinds
-            logical (omp_logical_kind) :: omp_get_nested
+            logical (4) :: omp_get_nested
           end function omp_get_nested
         end interface
 
         interface
           function omp_in_parallel ()
             use omp_lib_kinds
-            logical (omp_logical_kind) :: omp_in_parallel
+            logical (4) :: omp_in_parallel
           end function omp_in_parallel
         end interface
 
         interface
           function omp_test_lock (lock)
             use omp_lib_kinds
-            logical (omp_logical_kind) :: omp_test_lock
+            logical (4) :: omp_test_lock
             integer (omp_lock_kind), intent (inout) :: lock
           end function omp_test_lock
         end interface
@@ -155,35 +153,35 @@
         interface
           function omp_get_max_threads ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_max_threads
+            integer (4) :: omp_get_max_threads
           end function omp_get_max_threads
         end interface
 
         interface
           function omp_get_num_procs ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_num_procs
+            integer (4) :: omp_get_num_procs
           end function omp_get_num_procs
         end interface
 
         interface
           function omp_get_num_threads ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_num_threads
+            integer (4) :: omp_get_num_threads
           end function omp_get_num_threads
         end interface
 
         interface
           function omp_get_thread_num ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_thread_num
+            integer (4) :: omp_get_thread_num
           end function omp_get_thread_num
         end interface
 
         interface
           function omp_test_nest_lock (lock)
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_test_nest_lock
+            integer (4) :: omp_test_nest_lock
             integer (omp_nest_lock_kind), intent (inout) :: lock
           end function omp_test_nest_lock
         end interface
@@ -229,7 +227,7 @@
         interface
           function omp_get_thread_limit ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_thread_limit
+            integer (4) :: omp_get_thread_limit
           end function omp_get_thread_limit
         end interface
 
@@ -247,14 +245,14 @@
         interface
           function omp_get_max_active_levels ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_max_active_levels
+            integer (4) :: omp_get_max_active_levels
           end function omp_get_max_active_levels
         end interface
 
         interface
           function omp_get_level ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_level
+            integer (4) :: omp_get_level
           end function omp_get_level
         end interface
 
@@ -262,12 +260,12 @@
           function omp_get_ancestor_thread_num (level)
             use omp_lib_kinds
             integer (4), intent (in) :: level
-            integer (omp_integer_kind) :: omp_get_ancestor_thread_num
+            integer (4) :: omp_get_ancestor_thread_num
           end function omp_get_ancestor_thread_num
           function omp_get_ancestor_thread_num_8 (level)
             use omp_lib_kinds
             integer (8), intent (in) :: level
-            integer (omp_integer_kind) :: omp_get_ancestor_thread_num_8
+            integer (4) :: omp_get_ancestor_thread_num_8
           end function omp_get_ancestor_thread_num_8
         end interface
 
@@ -275,20 +273,27 @@
           function omp_get_team_size (level)
             use omp_lib_kinds
             integer (4), intent (in) :: level
-            integer (omp_integer_kind) :: omp_get_team_size
+            integer (4) :: omp_get_team_size
           end function omp_get_team_size
           function omp_get_team_size_8 (level)
             use omp_lib_kinds
             integer (8), intent (in) :: level
-            integer (omp_integer_kind) :: omp_get_team_size_8
+            integer (4) :: omp_get_team_size_8
           end function omp_get_team_size_8
         end interface
 
         interface
           function omp_get_active_level ()
             use omp_lib_kinds
-            integer (omp_integer_kind) :: omp_get_active_level
+            integer (4) :: omp_get_active_level
           end function omp_get_active_level
         end interface
 
+        interface
+          function omp_in_final ()
+            use omp_lib_kinds
+            logical (4) :: omp_in_final
+          end function omp_in_final
+        end interface
+
       end module omp_lib

libgomp/omp_lib.h.in

@@ -1,4 +1,4 @@
-!  Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
+!  Copyright (C) 2005, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
 !  Contributed by Jakub Jelinek <jakub@redhat.com>.
 
 !  This file is part of the GNU OpenMP Library (libgomp).
@@ -23,16 +23,17 @@
 !  <http://www.gnu.org/licenses/>.
 
       integer omp_lock_kind, omp_nest_lock_kind, openmp_version
-      integer omp_sched_kind, omp_sched_static, omp_sched_dynamic
-      integer omp_sched_guided, omp_sched_auto
       parameter (omp_lock_kind = @OMP_LOCK_KIND@)
       parameter (omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@)
+      integer omp_sched_kind
       parameter (omp_sched_kind = 4)
+      integer (omp_sched_kind) omp_sched_static, omp_sched_dynamic
+      integer (omp_sched_kind) omp_sched_guided, omp_sched_auto
       parameter (omp_sched_static = 1)
       parameter (omp_sched_dynamic = 2)
       parameter (omp_sched_guided = 3)
       parameter (omp_sched_auto = 4)
-      parameter (openmp_version = 200805)
+      parameter (openmp_version = 201107)
 
       external omp_init_lock, omp_init_nest_lock
       external omp_destroy_lock, omp_destroy_nest_lock
@@ -64,3 +65,6 @@
       integer(4) omp_get_thread_limit, omp_get_max_active_levels
       integer(4) omp_get_level, omp_get_ancestor_thread_num
       integer(4) omp_get_team_size, omp_get_active_level
+
+      external omp_in_final
+      logical(4) omp_in_final

libgomp/task.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
    Contributed by Richard Henderson <rth@redhat.com>.
 
    This file is part of the GNU OpenMP Library (libgomp).
@@ -41,6 +41,7 @@ gomp_init_task (struct gomp_task *task, struct gomp_task *parent_task,
   task->kind = GOMP_TASK_IMPLICIT;
   task->in_taskwait = false;
   task->in_tied_task = false;
+  task->final_task = false;
   task->children = NULL;
   gomp_sem_init (&task->taskwait_sem, 0);
 }
@@ -77,8 +78,7 @@ gomp_clear_parent (struct gomp_task *children)
 
 void
 GOMP_task (void (*fn) (void *), void *data, void (*cpyfn) (void *, void *),
-	   long arg_size, long arg_align, bool if_clause,
+	   long arg_size, long arg_align, bool if_clause, unsigned flags)
-	   unsigned flags __attribute__((unused)))
 {
   struct gomp_thread *thr = gomp_thread ();
   struct gomp_team *team = thr->ts.team;
@@ -95,12 +95,14 @@ GOMP_task (void (*fn) (void *), void *data, void (*cpyfn) (void *, void *),
 #endif
 
   if (!if_clause || team == NULL
+      || (thr->task && thr->task->final_task)
       || team->task_count > 64 * team->nthreads)
     {
       struct gomp_task task;
 
       gomp_init_task (&task, thr->task, gomp_icv (false));
       task.kind = GOMP_TASK_IFFALSE;
+      task.final_task = (thr->task && thr->task->final_task) || (flags & 2);
       if (thr->task)
 	task.in_tied_task = thr->task->in_tied_task;
       thr->task = &task;
@@ -145,6 +147,7 @@ GOMP_task (void (*fn) (void *), void *data, void (*cpyfn) (void *, void *),
       task->fn = fn;
       task->fn_data = arg;
       task->in_tied_task = true;
+      task->final_task = (flags & 2) >> 1;
       gomp_mutex_lock (&team->task_lock);
       if (parent->children)
 	{
@@ -362,3 +365,20 @@ GOMP_taskwait (void)
 	}
     }
 }
+
+/* Called when encountering a taskyield directive.  */
+
+void
+GOMP_taskyield (void)
+{
+  /* Nothing at the moment.  */
+}
+
+int
+omp_in_final (void)
+{
+  struct gomp_thread *thr = gomp_thread ();
+  return thr->task && thr->task->final_task;
+}
+
+ialias (omp_in_final)

libgomp/team.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2011
+   Free Software Foundation, Inc.
    Contributed by Richard Henderson <rth@redhat.com>.
 
    This file is part of the GNU OpenMP Library (libgomp).
@@ -260,6 +261,7 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
   struct gomp_thread_pool *pool;
   unsigned i, n, old_threads_used = 0;
   pthread_attr_t thread_attr, *attr;
+  unsigned long nthreads_var;
 
   thr = gomp_thread ();
   nested = thr->ts.team != NULL;
@@ -289,7 +291,12 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
 #endif
   thr->ts.static_trip = 0;
   thr->task = &team->implicit_task[0];
+  nthreads_var = icv->nthreads_var;
+  if (__builtin_expect (gomp_nthreads_var_list != NULL, 0)
+      && thr->ts.level < gomp_nthreads_var_list_len)
+    nthreads_var = gomp_nthreads_var_list[thr->ts.level];
   gomp_init_task (thr->task, task, icv);
+  team->implicit_task[0].icv.nthreads_var = nthreads_var;
 
   if (nthreads == 1)
     return;
@@ -342,6 +349,7 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
 	  nthr->ts.static_trip = 0;
 	  nthr->task = &team->implicit_task[i];
 	  gomp_init_task (nthr->task, task, icv);
+	  team->implicit_task[i].icv.nthreads_var = nthreads_var;
 	  nthr->fn = fn;
 	  nthr->data = data;
 	  team->ordered_release[i] = &nthr->release;
@@ -413,6 +421,7 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
       start_data->ts.static_trip = 0;
       start_data->task = &team->implicit_task[i];
       gomp_init_task (start_data->task, task, icv);
+      team->implicit_task[i].icv.nthreads_var = nthreads_var;
       start_data->thread_pool = pool;
       start_data->nested = nested;
 

libgomp/testsuite/libgomp.c++/atomic-2.C

@@ -0,0 +1,156 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+int x = 6;
+float y;
+
+int
+main (void)
+{
+  int v;
+  float f;
+  #pragma omp atomic read
+    v = x;
+  if (v != 6)
+    abort ();
+  #pragma omp atomic write
+    x = 17;
+  #pragma omp atomic read
+  v = x;
+  if (v != 17)
+    abort ();
+  #pragma omp atomic update
+    x++;
+  #pragma omp atomic read
+    v = x;
+  if (v != 18)
+    abort ();
+  #pragma omp atomic capture
+    v = x++;
+  if (v != 18)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 19)
+    abort ();
+  #pragma omp atomic capture
+    v = ++x;
+  if (v != 20)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 20)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x *= 3; }
+  if (v != 20)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 60)
+    abort ();
+  #pragma omp atomic capture
+    {
+      x |= 2;
+      v = x;
+    }
+  if (v != 62)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 62)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x++; }
+  if (v != 62)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; ++x; }
+  if (v != 63)
+    abort ();
+  #pragma omp atomic capture
+    {
+      ++x;
+      v = x;
+    }
+  if (v != 65)
+    abort ();
+#pragma omp atomic capture
+{x++;v=x;}if (v != 66)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 66)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x--; }
+  if (v != 66)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; --x; }
+  if (v != 65)
+    abort ();
+  #pragma omp atomic capture
+    {
+      --x;
+      v = x;
+    }
+  if (v != 63)
+    abort ();
+  #pragma omp atomic capture
+  { x--; v = x; } if (v != 62)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 62)
+    abort ();
+  #pragma omp atomic write
+    y = 17.5f;
+  #pragma omp atomic read
+    f = y;
+  if (f != 17.5)
+    abort ();
+  #pragma omp atomic update
+    y *= 2.0f;
+  #pragma omp atomic read
+    f = y;
+  if (y != 35.0)
+    abort ();
+  #pragma omp atomic capture
+    f = y *= 2.0f;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic capture
+    f = y++;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 71.0)
+    abort ();
+  #pragma omp atomic capture
+    f = --y;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic capture
+    { f = y; y /= 2.0f; }
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 35.0)
+    abort ();
+  #pragma omp atomic capture
+    { y /= 2.0f; f = y; }
+  if (f != 17.5)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 17.5)
+    abort ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/atomic-3.C

@@ -0,0 +1,74 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+bool v, x1, x2, x3, x4, x5, x6;
+
+void
+foo ()
+{
+  #pragma omp atomic capture
+  v = ++x1;
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  v = x2++;
+  if (v)
+    abort ();
+  #pragma omp atomic read
+  v = x3;
+  if (!v)
+    abort ();
+  #pragma omp atomic read
+  v = x4;
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x5; x5 |= 1; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { x6 |= 1; v = x6; }
+  if (!v)
+    abort ();
+}
+
+void
+bar ()
+{
+  #pragma omp atomic write
+  x1 = false;
+  #pragma omp atomic write
+  x2 = false;
+  #pragma omp atomic capture
+  { ++x1; v = x1; }
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x2; x2++; }
+  if (v)
+    abort ();
+  #pragma omp atomic write
+  x1 = false;
+  #pragma omp atomic write
+  x2 = false;
+  #pragma omp atomic capture
+  { x1++; v = x1; }
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x2; ++x2; }
+  if (v)
+    abort ();
+}
+
+int
+main ()
+{
+  #pragma omp atomic write
+  x3 = true;
+  #pragma omp atomic write
+  x4 = true;
+  foo ();
+  bar ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/atomic-4.C

@@ -0,0 +1,166 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+template <typename T, typename T2>
+int
+foo (void)
+{
+  extern T x;
+  extern T2 y;
+  T v;
+  T2 f;
+  #pragma omp atomic read
+    v = x;
+  if (v != 6)
+    abort ();
+  #pragma omp atomic write
+    x = 17;
+  #pragma omp atomic read
+  v = x;
+  if (v != 17)
+    abort ();
+  #pragma omp atomic update
+    x++;
+  #pragma omp atomic read
+    v = x;
+  if (v != 18)
+    abort ();
+  #pragma omp atomic capture
+    v = x++;
+  if (v != 18)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 19)
+    abort ();
+  #pragma omp atomic capture
+    v = ++x;
+  if (v != 20)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 20)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x *= 3; }
+  if (v != 20)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 60)
+    abort ();
+  #pragma omp atomic capture
+    {
+      x |= 2;
+      v = x;
+    }
+  if (v != 62)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 62)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x++; }
+  if (v != 62)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; ++x; }
+  if (v != 63)
+    abort ();
+  #pragma omp atomic capture
+    {
+      ++x;
+      v = x;
+    }
+  if (v != 65)
+    abort ();
+#pragma omp atomic capture
+{x++;v=x;}if (v != 66)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 66)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x--; }
+  if (v != 66)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; --x; }
+  if (v != 65)
+    abort ();
+  #pragma omp atomic capture
+    {
+      --x;
+      v = x;
+    }
+  if (v != 63)
+    abort ();
+  #pragma omp atomic capture
+  { x--; v = x; } if (v != 62)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 62)
+    abort ();
+  #pragma omp atomic write
+    y = 17.5f;
+  #pragma omp atomic read
+    f = y;
+  if (f != 17.5)
+    abort ();
+  #pragma omp atomic update
+    y *= 2.0f;
+  #pragma omp atomic read
+    f = y;
+  if (y != 35.0)
+    abort ();
+  #pragma omp atomic capture
+    f = y *= 2.0f;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic capture
+    f = y++;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 71.0)
+    abort ();
+  #pragma omp atomic capture
+    f = --y;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic capture
+    { f = y; y /= 2.0f; }
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 35.0)
+    abort ();
+  #pragma omp atomic capture
+    { y /= 2.0f; f = y; }
+  if (f != 17.5)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 17.5)
+    abort ();
+  return 0;
+}
+
+int x = 6;
+float y;
+
+int
+main ()
+{
+  foo <int, float> ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/atomic-5.C

@@ -0,0 +1,79 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+
+template <typename T>
+void
+foo ()
+{
+  extern T v, x1, x2, x3, x4, x5, x6;
+  #pragma omp atomic capture
+  v = ++x1;
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  v = x2++;
+  if (v)
+    abort ();
+  #pragma omp atomic read
+  v = x3;
+  if (!v)
+    abort ();
+  #pragma omp atomic read
+  v = x4;
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x5; x5 |= 1; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { x6 |= 1; v = x6; }
+  if (!v)
+    abort ();
+}
+
+template <typename T>
+void
+bar ()
+{
+  extern T v, x1, x2;
+  #pragma omp atomic write
+  x1 = false;
+  #pragma omp atomic write
+  x2 = false;
+  #pragma omp atomic capture
+  { ++x1; v = x1; }
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x2; x2++; }
+  if (v)
+    abort ();
+  #pragma omp atomic write
+  x1 = false;
+  #pragma omp atomic write
+  x2 = false;
+  #pragma omp atomic capture
+  { x1++; v = x1; }
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x2; ++x2; }
+  if (v)
+    abort ();
+}
+
+bool v, x1, x2, x3, x4, x5, x6;
+
+int
+main ()
+{
+  #pragma omp atomic write
+  x3 = true;
+  #pragma omp atomic write
+  x4 = true;
+  foo <bool> ();
+  bar <bool> ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/atomic-6.C

@@ -0,0 +1,58 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+long long l, m;
+int i, j;
+
+void
+foo (void)
+{
+  #pragma omp atomic read
+    i = l;
+  #pragma omp atomic read
+    m = j;
+  if (i != 77 || m != 88)
+    abort ();
+  #pragma omp atomic write
+    l = 1 + i + 6 * 1;
+  #pragma omp atomic write
+    j = 170 - 170 + m + 1 * 7;
+  #pragma omp atomic capture
+    i = l += 4;
+  #pragma omp atomic capture
+    m = j += 4;
+  if (i != 88 || m != 99)
+    abort ();
+  #pragma omp atomic capture
+    {
+      i = l;
+      l += 4;
+    }
+  #pragma omp atomic capture
+    {
+      m = j;
+      j += 4;
+    }
+  if (i != 88 || m != 99)
+    abort ();
+  #pragma omp atomic capture
+    {
+      l += 4;
+      i = l;
+    }
+  #pragma omp atomic capture
+    {
+      j += 4;
+      m = j;
+    }
+  if (i != 96 || m != 107)
+    abort ();
+}
+
+int
+main ()
+{
+  l = 77;
+  j = 88;
+  foo ();
+}

libgomp/testsuite/libgomp.c++/atomic-7.C

@@ -0,0 +1,63 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+
+template <typename S, typename T>
+void
+foo (void)
+{
+  extern S l, m;
+  extern T i, j;
+
+  #pragma omp atomic read
+    i = l;
+  #pragma omp atomic read
+    m = j;
+  if (i != 77 || m != 88)
+    abort ();
+  #pragma omp atomic write
+    l = 1 + i + 6 * 1;
+  #pragma omp atomic write
+    j = 170 - 170 + m + 1 * 7;
+  #pragma omp atomic capture
+    i = l += 4;
+  #pragma omp atomic capture
+    m = j += 4;
+  if (i != 88 || m != 99)
+    abort ();
+  #pragma omp atomic capture
+    {
+      i = l;
+      l += 4;
+    }
+  #pragma omp atomic capture
+    {
+      m = j;
+      j += 4;
+    }
+  if (i != 88 || m != 99)
+    abort ();
+  #pragma omp atomic capture
+    {
+      l += 4;
+      i = l;
+    }
+  #pragma omp atomic capture
+    {
+      j += 4;
+      m = j;
+    }
+  if (i != 96 || m != 107)
+    abort ();
+}
+
+long long l, m;
+int i, j;
+
+int
+main ()
+{
+  l = 77;
+  j = 88;
+  foo <long long, int> ();
+}

libgomp/testsuite/libgomp.c++/atomic-8.C

@@ -0,0 +1,137 @@
+// { dg-do run }
+
+extern "C" void abort ();
+int x = 6, cnt;
+
+int
+foo ()
+{
+  return cnt++;
+}
+
+int
+main ()
+{
+  int v, *p;
+  #pragma omp atomic update
+    x = x + 7;
+  #pragma omp atomic
+    x = x + 7 + 6;
+  #pragma omp atomic update
+    x = x + 2 * 3;
+  #pragma omp atomic
+    x = x * (2 - 1);
+  #pragma omp atomic read
+    v = x;
+  if (v != 32)
+    abort ();
+  #pragma omp atomic write
+    x = 0;
+  #pragma omp atomic capture
+    {
+      v = x;
+      x = x | 1 ^ 2;
+    }
+  if (v != 0)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = x;
+      x = x | 4 | 2;
+    }
+  if (v != 3)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 7)
+    abort ();
+  #pragma omp atomic capture
+    {
+      x = x ^ 6 & 2;
+      v = x;
+    }
+  if (v != 5)
+    abort ();
+  #pragma omp atomic capture
+    { x = x - (6 + 4); v = x; }
+  if (v != -5)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x = x - (1 | 2); }
+  if (v != -5)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != -8)
+    abort ();
+  #pragma omp atomic
+    x = x * -4 / 2;
+  #pragma omp atomic read
+    v = x;
+  if (v != 16)
+    abort ();
+  p = &x;
+  #pragma omp atomic update
+    p[foo (), 0] = p[foo (), 0] - 16;
+  #pragma omp atomic read
+    v = x;
+  if (cnt != 2 || v != 0)
+    abort ();
+  #pragma omp atomic capture
+    {
+      p[foo (), 0] += 6;
+      v = p[foo (), 0];
+    }
+  if (cnt != 4 || v != 6)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = p[foo (), 0];
+      p[foo (), 0] += 6;
+    }
+  if (cnt != 6 || v != 6)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 12)
+    abort ();
+  #pragma omp atomic capture
+    {
+      p[foo (), 0] = p[foo (), 0] + 6;
+      v = p[foo (), 0];
+    }
+  if (cnt != 9 || v != 18)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = p[foo (), 0];
+      p[foo (), 0] = p[foo (), 0] + 6;
+    }
+  if (cnt != 12 || v != 18)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 24)
+    abort ();
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; p[foo (), 0]++; }
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; ++p[foo (), 0]; }
+  #pragma omp atomic capture
+  { p[foo (), 0]++; v = p[foo (), 0]; }
+  #pragma omp atomic capture
+  { ++p[foo (), 0]; v = p[foo (), 0]; }
+  if (cnt != 20 || v != 28)
+    abort ();
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; p[foo (), 0]--; }
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; --p[foo (), 0]; }
+  #pragma omp atomic capture
+  { p[foo (), 0]--; v = p[foo (), 0]; }
+  #pragma omp atomic capture
+  { --p[foo (), 0]; v = p[foo (), 0]; }
+  if (cnt != 28 || v != 24)
+    abort ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/atomic-9.C

@@ -0,0 +1,148 @@
+// { dg-do run }
+
+extern "C" void abort ();
+
+int cnt;
+
+int
+foo ()
+{
+  return cnt++;
+}
+
+template <typename T>
+void
+bar ()
+{
+  extern T x;
+  T v, *p;
+  #pragma omp atomic update
+    x = x + 7;
+  #pragma omp atomic
+    x = x + 7 + 6;
+  #pragma omp atomic update
+    x = x + 2 * 3;
+  #pragma omp atomic
+    x = x * (2 - 1);
+  #pragma omp atomic read
+    v = x;
+  if (v != 32)
+    abort ();
+  #pragma omp atomic write
+    x = 0;
+  #pragma omp atomic capture
+    {
+      v = x;
+      x = x | 1 ^ 2;
+    }
+  if (v != 0)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = x;
+      x = x | 4 | 2;
+    }
+  if (v != 3)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 7)
+    abort ();
+  #pragma omp atomic capture
+    {
+      x = x ^ 6 & 2;
+      v = x;
+    }
+  if (v != 5)
+    abort ();
+  #pragma omp atomic capture
+    { x = x - (6 + 4); v = x; }
+  if (v != -5)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x = x - (1 | 2); }
+  if (v != -5)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != -8)
+    abort ();
+  #pragma omp atomic
+    x = x * -4 / 2;
+  #pragma omp atomic read
+    v = x;
+  if (v != 16)
+    abort ();
+  p = &x;
+  #pragma omp atomic update
+    p[foo (), 0] = p[foo (), 0] - 16;
+  #pragma omp atomic read
+    v = x;
+  if (cnt != 2 || v != 0)
+    abort ();
+  #pragma omp atomic capture
+    {
+      p[foo (), 0] += 6;
+      v = p[foo (), 0];
+    }
+  if (cnt != 4 || v != 6)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = p[foo (), 0];
+      p[foo (), 0] += 6;
+    }
+  if (cnt != 6 || v != 6)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 12)
+    abort ();
+  #pragma omp atomic capture
+    {
+      p[foo (), 0] = p[foo (), 0] + 6;
+      v = p[foo (), 0];
+    }
+  if (cnt != 9 || v != 18)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = p[foo (), 0];
+      p[foo (), 0] = p[foo (), 0] + 6;
+    }
+  if (cnt != 12 || v != 18)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 24)
+    abort ();
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; p[foo (), 0]++; }
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; ++p[foo (), 0]; }
+  #pragma omp atomic capture
+  { p[foo (), 0]++; v = p[foo (), 0]; }
+  #pragma omp atomic capture
+  { ++p[foo (), 0]; v = p[foo (), 0]; }
+  if (cnt != 20 || v != 28)
+    abort ();
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; p[foo (), 0]--; }
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; --p[foo (), 0]; }
+  #pragma omp atomic capture
+  { p[foo (), 0]--; v = p[foo (), 0]; }
+  #pragma omp atomic capture
+  { --p[foo (), 0]; v = p[foo (), 0]; }
+  if (cnt != 28 || v != 24)
+    abort ();
+}
+
+int x = 6;
+
+int
+main ()
+{
+  bar <int> ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/reduction-4.C

@@ -0,0 +1,54 @@
+// { dg-do run }
+
+extern "C" void abort (void);
+
+template <typename I, typename F>
+void
+foo ()
+{
+  I j = -10000;
+  F f = 1024.0;
+  int i;
+  #pragma omp parallel for reduction (min:f) reduction (max:j)
+    for (i = 0; i < 4; i++)
+      switch (i)
+	{
+	case 0:
+	  if (j < -16) j = -16; break;
+	case 1:
+	  if (f > -2.0) f = -2.0; break;
+	case 2:
+	  if (j < 8) j = 8; if (f > 9.0) f = 9.0; break;
+	case 3:
+	  break;
+	}
+  if (j != 8 || f != -2.0)
+    abort ();
+}
+
+int
+main ()
+{
+  int j = -10000;
+  float f = 1024.0;
+  int i;
+  #pragma omp parallel for reduction (min:f) reduction (max:j)
+    for (i = 0; i < 4; i++)
+      switch (i)
+	{
+	case 0:
+	  if (j < -16) j = -16; break;
+	case 1:
+	  if (f > -2.0) f = -2.0; break;
+	case 2:
+	  if (j < 8) j = 8; if (f > 9.0) f = 9.0; break;
+	case 3:
+	  break;
+	}
+  if (j != 8 || f != -2.0)
+    abort ();
+  foo <int, float> ();
+  foo <long, double> ();
+  foo <long long, long double> ();
+  return 0;
+}

libgomp/testsuite/libgomp.c++/task-8.C

@@ -0,0 +1,44 @@
+// { dg-do run }
+
+#include <omp.h>
+#include <cstdlib>
+
+int err;
+
+int
+main ()
+{
+  int e;
+#pragma omp parallel shared(err)
+  {
+    if (omp_in_final ())
+      #pragma omp atomic write
+	err = 1;
+    #pragma omp task if (0) shared(err)
+      {
+	if (omp_in_final ())
+	  #pragma omp atomic write
+	    err = 1;
+	#pragma omp task if (0) shared(err)
+	  if (omp_in_final ())
+	    #pragma omp atomic write
+	      err = 1;
+      }
+    #pragma omp task final (1) shared(err)
+      {
+	if (!omp_in_final ())
+	  #pragma omp atomic write
+	    err = 1;
+	#pragma omp taskyield
+	#pragma omp taskwait
+	#pragma omp task shared(err)
+	  if (!omp_in_final ())
+	    #pragma omp atomic write
+	      err = 1;
+      }
+  }
+  #pragma omp atomic read
+    e = err;
+  if (e)
+    abort ();
+}

libgomp/testsuite/libgomp.c/atomic-11.c

@@ -0,0 +1,156 @@
+/* { dg-do run } */
+
+extern void abort (void);
+int x = 6;
+float y;
+
+int
+main (void)
+{
+  int v;
+  float f;
+  #pragma omp atomic read
+    v = x;
+  if (v != 6)
+    abort ();
+  #pragma omp atomic write
+    x = 17;
+  #pragma omp atomic read
+  v = x;
+  if (v != 17)
+    abort ();
+  #pragma omp atomic update
+    x++;
+  #pragma omp atomic read
+    v = x;
+  if (v != 18)
+    abort ();
+  #pragma omp atomic capture
+    v = x++;
+  if (v != 18)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 19)
+    abort ();
+  #pragma omp atomic capture
+    v = ++x;
+  if (v != 20)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 20)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x *= 3; }
+  if (v != 20)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 60)
+    abort ();
+  #pragma omp atomic capture
+    {
+      x |= 2;
+      v = x;
+    }
+  if (v != 62)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 62)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x++; }
+  if (v != 62)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; ++x; }
+  if (v != 63)
+    abort ();
+  #pragma omp atomic capture
+    {
+      ++x;
+      v = x;
+    }
+  if (v != 65)
+    abort ();
+#pragma omp atomic capture
+{x++;v=x;}if (v != 66)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 66)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x--; }
+  if (v != 66)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; --x; }
+  if (v != 65)
+    abort ();
+  #pragma omp atomic capture
+    {
+      --x;
+      v = x;
+    }
+  if (v != 63)
+    abort ();
+  #pragma omp atomic capture
+  { x--; v = x; } if (v != 62)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 62)
+    abort ();
+  #pragma omp atomic write
+    y = 17.5f;
+  #pragma omp atomic read
+    f = y;
+  if (f != 17.5)
+    abort ();
+  #pragma omp atomic update
+    y *= 2.0f;
+  #pragma omp atomic read
+    f = y;
+  if (y != 35.0)
+    abort ();
+  #pragma omp atomic capture
+    f = y *= 2.0f;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic capture
+    f = y++;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 71.0)
+    abort ();
+  #pragma omp atomic capture
+    f = --y;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic capture
+    { f = y; y /= 2.0f; }
+  if (f != 70.0)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 35.0)
+    abort ();
+  #pragma omp atomic capture
+    { y /= 2.0f; f = y; }
+  if (f != 17.5)
+    abort ();
+  #pragma omp atomic read
+    f = y;
+  if (f != 17.5)
+    abort ();
+  return 0;
+}

libgomp/testsuite/libgomp.c/atomic-12.c

@@ -0,0 +1,98 @@
+/* { dg-do run } */
+
+extern void abort (void);
+_Bool v, x1, x2, x3, x4, x5, x6;
+
+void
+foo (void)
+{
+  #pragma omp atomic capture
+  v = ++x1;
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  v = x2++;
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  v = --x3;
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  v = x4--;
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x5; x5 |= 1; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { x6 |= 1; v = x6; }
+  if (!v)
+    abort ();
+}
+
+void
+bar (void)
+{
+  #pragma omp atomic write
+  x1 = 0;
+  #pragma omp atomic write
+  x2 = 0;
+  #pragma omp atomic write
+  x3 = 1;
+  #pragma omp atomic write
+  x4 = 1;
+  #pragma omp atomic capture
+  { ++x1; v = x1; }
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x2; x2++; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { --x3; v = x3; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x4; x4--; }
+  if (!v)
+    abort ();
+  #pragma omp atomic write
+  x1 = 0;
+  #pragma omp atomic write
+  x2 = 0;
+  #pragma omp atomic write
+  x3 = 1;
+  #pragma omp atomic write
+  x4 = 1;
+  #pragma omp atomic capture
+  { x1++; v = x1; }
+  if (!v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x2; ++x2; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { x3--; v = x3; }
+  if (v)
+    abort ();
+  #pragma omp atomic capture
+  { v = x4; --x4; }
+  if (!v)
+    abort ();
+}
+
+int
+main ()
+{
+  #pragma omp atomic write
+  x3 = 1;
+  #pragma omp atomic write
+  x4 = 1;
+  foo ();
+  bar ();
+  return 0;
+}

libgomp/testsuite/libgomp.c/atomic-13.c

@@ -0,0 +1,59 @@
+/* { dg-do run } */
+
+extern void abort (void);
+long long l, m;
+int i, j;
+
+void
+foo (void)
+{
+  #pragma omp atomic read
+    i = l;
+  #pragma omp atomic read
+    m = j;
+  if (i != 77 || m != 88)
+    abort ();
+  #pragma omp atomic write
+    l = 1 + i + 6 * 1;
+  #pragma omp atomic write
+    j = 170 - 170 + m + 1 * 7;
+  #pragma omp atomic capture
+    i = l += 4;
+  #pragma omp atomic capture
+    m = j += 4;
+  if (i != 88 || m != 99)
+    abort ();
+  #pragma omp atomic capture
+    {
+      i = l;
+      l += 4;
+    }
+  #pragma omp atomic capture
+    {
+      m = j;
+      j += 4;
+    }
+  if (i != 88 || m != 99)
+    abort ();
+  #pragma omp atomic capture
+    {
+      l += 4;
+      i = l;
+    }
+  #pragma omp atomic capture
+    {
+      j += 4;
+      m = j;
+    }
+  if (i != 96 || m != 107)
+    abort ();
+}
+
+int
+main ()
+{
+  l = 77;
+  j = 88;
+  foo ();
+  return 0;
+}

libgomp/testsuite/libgomp.c/atomic-14.c

@@ -0,0 +1,137 @@
+/* { dg-do run } */
+
+extern void abort (void);
+int x = 6, cnt;
+
+int
+foo (void)
+{
+  return cnt++;
+}
+
+int
+main ()
+{
+  int v, *p;
+  #pragma omp atomic update
+    x = x + 7;
+  #pragma omp atomic
+    x = x + 7 + 6;
+  #pragma omp atomic update
+    x = x + 2 * 3;
+  #pragma omp atomic
+    x = x * (2 - 1);
+  #pragma omp atomic read
+    v = x;
+  if (v != 32)
+    abort ();
+  #pragma omp atomic write
+    x = 0;
+  #pragma omp atomic capture
+    {
+      v = x;
+      x = x | 1 ^ 2;
+    }
+  if (v != 0)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = x;
+      x = x | 4 | 2;
+    }
+  if (v != 3)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 7)
+    abort ();
+  #pragma omp atomic capture
+    {
+      x = x ^ 6 & 2;
+      v = x;
+    }
+  if (v != 5)
+    abort ();
+  #pragma omp atomic capture
+    { x = x - (6 + 4); v = x; }
+  if (v != -5)
+    abort ();
+  #pragma omp atomic capture
+    { v = x; x = x - (1 | 2); }
+  if (v != -5)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != -8)
+    abort ();
+  #pragma omp atomic
+    x = x * -4 / 2;
+  #pragma omp atomic read
+    v = x;
+  if (v != 16)
+    abort ();
+  p = &x;
+  #pragma omp atomic update
+    p[foo (), 0] = p[foo (), 0] - 16;
+  #pragma omp atomic read
+    v = x;
+  if (cnt != 2 || v != 0)
+    abort ();
+  #pragma omp atomic capture
+    {
+      p[foo (), 0] += 6;
+      v = p[foo (), 0];
+    }
+  if (cnt != 4 || v != 6)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = p[foo (), 0];
+      p[foo (), 0] += 6;
+    }
+  if (cnt != 6 || v != 6)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 12)
+    abort ();
+  #pragma omp atomic capture
+    {
+      p[foo (), 0] = p[foo (), 0] + 6;
+      v = p[foo (), 0];
+    }
+  if (cnt != 9 || v != 18)
+    abort ();
+  #pragma omp atomic capture
+    {
+      v = p[foo (), 0];
+      p[foo (), 0] = p[foo (), 0] + 6;
+    }
+  if (cnt != 12 || v != 18)
+    abort ();
+  #pragma omp atomic read
+    v = x;
+  if (v != 24)
+    abort ();
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; p[foo (), 0]++; }
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; ++p[foo (), 0]; }
+  #pragma omp atomic capture
+  { p[foo (), 0]++; v = p[foo (), 0]; }
+  #pragma omp atomic capture
+  { ++p[foo (), 0]; v = p[foo (), 0]; }
+  if (cnt != 20 || v != 28)
+    abort ();
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; p[foo (), 0]--; }
+  #pragma omp atomic capture
+  { v = p[foo (), 0]; --p[foo (), 0]; }
+  #pragma omp atomic capture
+  { p[foo (), 0]--; v = p[foo (), 0]; }
+  #pragma omp atomic capture
+  { --p[foo (), 0]; v = p[foo (), 0]; }
+  if (cnt != 28 || v != 24)
+    abort ();
+  return 0;
+}

libgomp/testsuite/libgomp.c/reduction-6.c

@@ -0,0 +1,29 @@
+/* { dg-do run } */
+
+extern void abort (void);
+int j;
+float f;
+
+int
+main ()
+{
+  j = -10000;
+  f = 1024.0;
+  int i;
+  #pragma omp parallel for reduction (min:f) reduction (max:j)
+    for (i = 0; i < 4; i++)
+      switch (i)
+	{
+	case 0:
+	  if (j < -16) j = -16; break;
+	case 1:
+	  if (f > -2.0) f = -2.0; break;
+	case 2:
+	  if (j < 8) j = 8; if (f > 9.0) f = 9.0; break;
+	case 3:
+	  break;
+	}
+  if (j != 8 || f != -2.0)
+    abort ();
+  return 0;
+}

libgomp/testsuite/libgomp.c/task-5.c

@@ -0,0 +1,45 @@
+/* { dg-do run } */
+
+#include <omp.h>
+#include <stdlib.h>
+
+int err;
+
+int
+main ()
+{
+  int e;
+#pragma omp parallel shared(err)
+  {
+    if (omp_in_final ())
+      #pragma omp atomic write
+	err = 1;
+    #pragma omp task if (0) shared(err)
+      {
+	if (omp_in_final ())
+	  #pragma omp atomic write
+	    err = 1;
+	#pragma omp task if (0) shared(err)
+	  if (omp_in_final ())
+	    #pragma omp atomic write
+	      err = 1;
+      }
+    #pragma omp task final (1) shared(err)
+      {
+	if (!omp_in_final ())
+	  #pragma omp atomic write
+	    err = 1;
+	#pragma omp taskyield
+	#pragma omp taskwait
+	#pragma omp task shared(err)
+	  if (!omp_in_final ())
+	    #pragma omp atomic write
+	      err = 1;
+      }
+  }
+  #pragma omp atomic read
+    e = err;
+  if (e)
+    abort ();
+  return 0;
+}

libgomp/testsuite/libgomp.fortran/allocatable7.f90

@@ -0,0 +1,16 @@
+! { dg-do run }
+
+  integer, allocatable :: a(:)
+  logical :: l
+  l = .false.
+!$omp parallel firstprivate (a) reduction (.or.:l)
+  l = allocated (a)
+  allocate (a(10))
+  l = l .or. .not. allocated (a)
+  a = 10
+  if (any (a .ne. 10)) l = .true.
+  deallocate (a)
+  l = l .or. allocated (a)
+!$omp end parallel
+  if (l) call abort
+end

libgomp/testsuite/libgomp.fortran/allocatable8.f90

@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+!$ use omp_lib
+
+  integer, save, allocatable :: a(:, :)
+  logical :: l
+!$omp threadprivate (a)
+  if (allocated (a)) call abort
+  l = .false.
+!$omp parallel copyin (a) num_threads (4) reduction(.or.:l)
+  l = l.or.allocated (a)
+!$omp end parallel
+  if (l.or.allocated (a)) call abort
+end

libgomp/testsuite/libgomp.fortran/crayptr3.f90

@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  use omp_lib
+  integer :: a, b, c, i, p
+  logical :: l
+  pointer (ip, p)
+  a = 1
+  b = 2
+  c = 3
+  l = .false.
+  ip = loc (a)
+
+!$omp parallel num_threads (2) reduction (.or.:l) firstprivate (ip)
+  l = p .ne. 1
+  ip = loc (b)
+  if (omp_get_thread_num () .eq. 1) ip = loc (c)
+  l = l .or. (p .ne. (2 + omp_get_thread_num ()))
+!$omp end parallel
+
+  if (l) call abort
+
+  l = .false.
+  ip = loc (a)
+!$omp parallel do num_threads (2) reduction (.or.:l) &
+!$omp & firstprivate (ip) lastprivate (ip)
+  do i = 0, 1
+    l = l .or. (p .ne. 1)
+    ip = loc (b)
+    if (i .eq. 1) ip = loc (c)
+    l = l .or. (p .ne. (2 + i))
+  end do
+
+  if (l) call abort
+  if (p .ne. 3) call abort
+end

libgomp/testsuite/libgomp.fortran/omp_atomic3.f90

@@ -0,0 +1,58 @@
+! { dg-do run }
+    integer (kind = 4) :: a, a2
+    integer (kind = 2) :: b, b2
+    real :: c, f
+    double precision :: d, d2, c2
+    integer, dimension (10) :: e
+!$omp atomic write
+    a = 1
+!$omp atomic write
+    b = 2
+!$omp end atomic
+!$omp atomic write
+    c = 3
+!$omp atomic write
+    d = 1 + 2 + 3 - 2
+    e = 5
+!$omp atomic write
+    f = 6
+!$omp end atomic
+!$omp atomic
+    a = a + 4
+!$omp end atomic
+!$omp atomic update
+    b = 4 - b
+!$omp atomic
+    c = c * 2
+!$omp atomic update
+    d = 2 / d
+!$omp end atomic
+!$omp atomic read
+    a2 = a
+!$omp atomic read
+    b2 = b
+!$omp end atomic
+!$omp atomic read
+    c2 = c
+!$omp atomic read
+    d2 = d
+    if (a2 .ne. 5 .or. b2 .ne. 2 .or. c2 .ne. 6 .or. d2 .ne. 0.5) call abort
+!$omp atomic write
+    d = 1.2
+!$omp atomic
+    a = a + c + d
+!$omp atomic
+    b = b - (a + c + d)
+    if (a .ne. 12 .or. b .ne. -17) call abort
+!$omp atomic
+    a = c + d + a
+!$omp atomic
+    b = a + c + d - b
+    if (a .ne. 19 .or. b .ne. 43) call abort
+!$omp atomic
+    b = (a + c + d) - b
+    a = 32
+!$omp atomic
+    a = a / 3.4
+    if (a .ne. 9 .or. b .ne. -16) call abort
+end

libgomp/testsuite/libgomp.fortran/omp_atomic4.f90

@@ -0,0 +1,37 @@
+! { dg-do run }
+    integer (kind = 4) :: a, a2
+    integer (kind = 2) :: b, b2
+    real :: c
+    double precision :: d, d2, c2
+    integer, dimension (10) :: e
+!$omp atomic write
+    a = 1
+!$omp atomic write
+    b = 2
+!$omp atomic write
+    c = 3
+!$omp atomic write
+    d = 4
+!$omp atomic capture
+    a2 = a
+    a = a + 4
+!$omp end atomic
+!$omp atomic capture
+    b = b - 18
+    b2 = b
+!$omp end atomic
+!$omp atomic capture
+    c2 = c
+    c = 2.0 * c
+!$omp end atomic
+!$omp atomic capture
+    d = d / 2.0
+    d2 = d
+!$omp end atomic
+    if (a2 .ne. 1 .or. b2 .ne. -16 .or. c2 .ne. 3 .or. d2 .ne. 2) call abort
+!$omp atomic read
+    a2 = a
+!$omp atomic read
+    c2 = c
+    if (a2 .ne. 5 .or. b2 .ne. -16 .or. c2 .ne. 6 .or. d2 .ne. 2) call abort
+end

libgomp/testsuite/libgomp.fortran/pointer1.f90

@@ -0,0 +1,77 @@
+! { dg-do run }
+  integer, pointer :: a, c(:)
+  integer, target :: b, d(10)
+  b = 0
+  a => b
+  d = 0
+  c => d
+  call foo (a, c)
+  b = 0
+  d = 0
+  call bar (a, c)
+contains
+  subroutine foo (a, c)
+    integer, pointer :: a, c(:), b, d(:)
+    integer :: r, r2
+    r = 0
+    !$omp parallel firstprivate (a, c) reduction (+:r)
+      !$omp atomic
+        a = a + 1
+      !$omp atomic
+        c(1) = c(1) + 1
+      r = r + 1
+    !$omp end parallel
+    if (a.ne.r.or.c(1).ne.r) call abort
+    r2 = r
+    b => a
+    d => c
+    r = 0
+    !$omp parallel firstprivate (b, d) reduction (+:r)
+      !$omp atomic
+        b = b + 1
+      !$omp atomic
+        d(1) = d(1) + 1
+      r = r + 1
+    !$omp end parallel
+    if (b.ne.r+r2.or.d(1).ne.r+r2) call abort
+  end subroutine foo
+  subroutine bar (a, c)
+    integer, pointer :: a, c(:), b, d(:)
+    integer, target :: q, r(5)
+    integer :: i
+    q = 17
+    r = 21
+    b => a
+    d => c
+    !$omp parallel do firstprivate (a, c) lastprivate (a, c)
+      do i = 1, 100
+        !$omp atomic
+          a = a + 1
+        !$omp atomic
+          c((i+9)/10) = c((i+9)/10) + 1
+        if (i.eq.100) then
+          a => q
+          c => r
+	end if
+      end do
+    !$omp end parallel do
+    if (b.ne.100.or.any(d.ne.10)) call abort
+    if (a.ne.17.or.any(c.ne.21)) call abort
+    a => b
+    c => d
+    !$omp parallel do firstprivate (b, d) lastprivate (b, d)
+      do i = 1, 100
+        !$omp atomic
+          b = b + 1
+        !$omp atomic
+          d((i+9)/10) = d((i+9)/10) + 1
+        if (i.eq.100) then
+          b => q
+          d => r
+	end if
+      end do
+    !$omp end parallel do
+    if (a.ne.200.or.any(c.ne.20)) call abort
+    if (b.ne.17.or.any(d.ne.21)) call abort
+  end subroutine bar
+end

libgomp/testsuite/libgomp.fortran/pointer2.f90

@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+  integer, pointer, save :: thr(:)
+!$omp threadprivate (thr)
+  integer, target :: s(3), t(3), u(3)
+  integer :: i
+  logical :: l
+  s = 2
+  t = 7
+  u = 13
+  thr => t
+  l = .false.
+  i = 0
+!$omp parallel copyin (thr) reduction(.or.:l) reduction(+:i)
+  if (any (thr.ne.7)) l = .true.
+  thr => s
+!$omp master
+  thr => u
+!$omp end master
+!$omp atomic
+  thr(1) = thr(1) + 1
+  i = i + 1
+!$omp end parallel
+  if (l) call abort
+  if (thr(1).ne.14) call abort
+  if (s(1).ne.1+i) call abort
+  if (u(1).ne.14) call abort
+end

libgomp/testsuite/libgomp.fortran/task4.f90

@@ -0,0 +1,45 @@
+! { dg-do run }
+
+  use omp_lib
+  integer :: err, e
+
+!$omp atomic write
+  err = 0
+!$omp parallel shared(err) private(e)
+  if (omp_in_final ()) then
+!$omp atomic write
+    err = 1
+  endif
+!$omp task if (.false.) shared(err)
+  if (omp_in_final ()) then
+!$omp atomic write
+    err = 1
+  endif
+!$omp task if (.false.) shared(err)
+  if (omp_in_final ()) then
+!$omp atomic write
+    err = 1
+  endif
+!$omp end task
+!$omp end task
+!$omp atomic read
+  e = err
+!$omp task final (e .eq. 0) shared(err)
+  if (.not.omp_in_final ()) then
+!$omp atomic write
+    err = 1
+  endif
+!$omp taskyield
+!$omp taskwait
+!$omp task shared(err)
+  if (.not.omp_in_final ()) then
+!$omp atomic write
+    err = 1
+  endif
+!$omp end task
+!$omp end task
+!$omp end parallel
+!$omp atomic read
+  e = err
+  if (e .ne. 0) call abort
+end