Hi!
This patch adds Fortran support for OpenMP 3.1 atomics.
Tested on x86_64-linux, committed to gomp-3_1-branch.
2011-04-27 Jakub Jelinek <ja...@redhat.com>
* gfortran.h (gfc_statement): Add ST_OMP_END_ATOMIC.
(gfc_omp_atomic_op): New enum typedef.
(struct gfc_code): Add ext.omp_atomic.
* parse.c (decode_omp_directive): Handle !$omp end atomic.
(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.
* openmp.c (gfc_match_omp_atomic): Match optional
read/write/update/capture keywords after !$omp atomic.
(resolve_omp_atomic): Handle all OpenMP 3.1 atomic forms.
* trans-openmp.c (gfc_trans_omp_atomic): Likewise.
* gfortran.dg/gomp/omp_atomic2.f90: New test.
* testsuite/libgomp.fortran/omp_atomic3.f90: New test.
* testsuite/libgomp.fortran/omp_atomic4.f90: New test.
--- gcc/fortran/gfortran.h.jj 2011-02-24 14:19:08.000000000 +0100
+++ gcc/fortran/gfortran.h 2011-04-27 10:35:24.000000000 +0200
@@ -200,9 +200,9 @@ 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_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
- ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
+ ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
+ ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
+ 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,
@@ -2064,6 +2064,15 @@ typedef enum
}
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;
@@ -2114,6 +2123,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/openmp.c.jj 2011-04-20 11:19:18.000000000 +0200
+++ gcc/fortran/openmp.c 2011-04-27 15:42:04.000000000 +0200
@@ -700,13 +700,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;
}
@@ -1100,12 +1109,18 @@ is_conversion (gfc_expr *expr, bool wide
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
@@ -1123,7 +1138,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)
{
@@ -1325,6 +1419,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/trans-openmp.c.jj 2011-04-20 11:19:18.000000000 +0200
+++ gcc/fortran/trans-openmp.c 2011-04-27 16:03:24.000000000 +0200
@@ -1000,35 +1000,85 @@ static tree gfc_trans_omp_workshare (gfc
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)
@@ -1144,25 +1194,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)
- x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
+ if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
+ 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);
}
--- gcc/fortran/parse.c.jj 2011-02-24 14:19:08.000000000 +0100
+++ gcc/fortran/parse.c 2011-04-27 15:36:59.000000000 +0200
@@ -521,6 +521,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);
@@ -1458,6 +1459,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;
@@ -3396,12 +3400,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);
@@ -3410,21 +3415,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;
}
@@ -3534,8 +3553,8 @@ parse_omp_structured_block (gfc_statemen
continue;
case ST_OMP_ATOMIC:
- parse_omp_atomic ();
- break;
+ st = parse_omp_atomic ();
+ continue;
default:
cycle = false;
@@ -3715,8 +3734,8 @@ parse_executable (gfc_statement st)
continue;
case ST_OMP_ATOMIC:
- parse_omp_atomic ();
- break;
+ st = parse_omp_atomic ();
+ continue;
default:
return st;
--- gcc/testsuite/gfortran.dg/gomp/omp_atomic2.f90.jj 2011-04-27
16:14:36.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/omp_atomic2.f90 2011-04-27
16:10:47.000000000 +0200
@@ -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
--- libgomp/testsuite/libgomp.fortran/omp_atomic4.f90.jj 2011-04-27
16:13:58.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_atomic4.f90 2011-04-27
14:27:34.000000000 +0200
@@ -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/omp_atomic3.f90.jj 2011-04-27
14:03:49.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_atomic3.f90 2011-04-27
13:34:12.000000000 +0200
@@ -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
Jakub
