From: Tobias Burnus Date: Tue, 31 May 2011 20:04:09 +0000 (+0200) Subject: re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays]) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=da661a58be64d71f95def0309a692fc4a8cd2684;p=gcc.git re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays]) 2011-05-31 Tobias Burnus PR fortran/18918 * intrinsic.c (klass): Add CLASS_ATOMIC. (add_subroutines): Add atomic_ref/atomic_define. * intrinsic.texi (ATOMIC_REF, ATOMIC_DEFINE): Document. * intrinsic.h (gfc_check_atomic_def, gfc_check_atomic_ref, gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New prototypes. * gfortran.h (gfc_isym_id): Add GFC_ISYM_ATOMIC_DEF and GFC_ISYM_ATOMIC_REF. (gfc_atomic_int_kind, gfc_atomic_logical_kind): New global vars. * iresolve.c (gfc_resolve_atomic_def, gfc_resolve_atomic_ref): * New functions. * check.c (gfc_check_atomic, gfc_check_atomic_def, gfc_check_atomic_ref): New functions. * iso-fortran-env.def (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND): Change kind value. * trans-intrinsic.c (conv_intrinsic_atomic_def, conv_intrinsic_atomic_ref, gfc_conv_intrinsic_subroutine): New functions. (conv_intrinsic_move_alloc) Renamed from gfc_conv_intrinsic_move_alloc - and made static. * trans.h (gfc_conv_intrinsic_move_alloc): Remove. (gfc_conv_intrinsic_subroutine) Add prototype. * trans.c (trans_code): Call gfc_conv_intrinsic_subroutine. From-SVN: r174510 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b962ff55acc..c24489bd48a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,32 @@ +2011-05-31 Tobias Burnus + + PR fortran/18918 + * intrinsic.c (klass): Add CLASS_ATOMIC. + (add_subroutines): Add atomic_ref/atomic_define. + * intrinsic.texi (ATOMIC_REF, ATOMIC_DEFINE): Document. + * intrinsic.h (gfc_check_atomic_def, gfc_check_atomic_ref, + gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New prototypes. + * gfortran.h (gfc_isym_id): Add GFC_ISYM_ATOMIC_DEF + and GFC_ISYM_ATOMIC_REF. + (gfc_atomic_int_kind, gfc_atomic_logical_kind): New global vars. + * iresolve.c (gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New + functions. + * check.c (gfc_check_atomic, gfc_check_atomic_def, + gfc_check_atomic_ref): New functions. + * iso-fortran-env.def (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, + ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND): Change kind value. + * trans-intrinsic.c (conv_intrinsic_atomic_def, + conv_intrinsic_atomic_ref, gfc_conv_intrinsic_subroutine): New + functions. + (conv_intrinsic_move_alloc) Renamed from + gfc_conv_intrinsic_move_alloc - and made static. + * trans.h (gfc_conv_intrinsic_move_alloc): Remove. + (gfc_conv_intrinsic_subroutine) Add prototype. + * trans.c (trans_code): Call gfc_conv_intrinsic_subroutine. + * trans-types (gfc_atomic_int_kind, gfc_atomic_logical_kind): New + global vars. + (gfc_init_kinds): Set them. + 2011-05-31 Tobias Burnus PR fortran/18918 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 70c23e663e1..11789673115 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -973,6 +973,72 @@ gfc_check_atan2 (gfc_expr *y, gfc_expr *x) } +static gfc_try +gfc_check_atomic (gfc_expr *atom, gfc_expr *value) +{ + if (!(atom->ts.type == BT_INTEGER && atom->ts.kind == gfc_atomic_int_kind) + && !(atom->ts.type == BT_LOGICAL + && atom->ts.kind == gfc_atomic_logical_kind)) + { + gfc_error ("ATOM argument at %L to intrinsic function %s shall be an " + "integer of ATOMIC_INT_KIND or a logical of " + "ATOMIC_LOGICAL_KIND", &atom->where, gfc_current_intrinsic); + return FAILURE; + } + + if (!gfc_expr_attr (atom).codimension) + { + gfc_error ("ATOM argument at %L of the %s intrinsic function shall be a " + "coarray or coindexed", &atom->where, gfc_current_intrinsic); + return FAILURE; + } + + if (atom->ts.type != value->ts.type) + { + gfc_error ("ATOM and VALUE argument of the %s intrinsic function shall " + "have the same type at %L", gfc_current_intrinsic, + &value->where); + return FAILURE; + } + + return SUCCESS; +} + + +gfc_try +gfc_check_atomic_def (gfc_expr *atom, gfc_expr *value) +{ + if (scalar_check (atom, 0) == FAILURE || scalar_check (value, 1) == FAILURE) + return FAILURE; + + if (gfc_check_vardef_context (atom, false, NULL) == FAILURE) + { + gfc_error ("ATOM argument of the %s intrinsic function at %L shall be " + "definable", gfc_current_intrinsic, &atom->where); + return FAILURE; + } + + return gfc_check_atomic (atom, value); +} + + +gfc_try +gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom) +{ + if (scalar_check (value, 0) == FAILURE || scalar_check (atom, 1) == FAILURE) + return FAILURE; + + if (gfc_check_vardef_context (value, false, NULL) == FAILURE) + { + gfc_error ("VALUE argument of the %s intrinsic function at %L shall be " + "definable", gfc_current_intrinsic, &value->where); + return FAILURE; + } + + return gfc_check_atomic (atom, value); +} + + /* BESJN and BESYN functions. */ gfc_try diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 72e412b3b9f..ff824244d86 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -306,6 +306,8 @@ enum gfc_isym_id GFC_ISYM_ATAN, GFC_ISYM_ATAN2, GFC_ISYM_ATANH, + GFC_ISYM_ATOMIC_DEF, + GFC_ISYM_ATOMIC_REF, GFC_ISYM_BGE, GFC_ISYM_BGT, GFC_ISYM_BIT_SIZE, @@ -2464,6 +2466,8 @@ extern int gfc_default_character_kind; extern int gfc_default_logical_kind; extern int gfc_default_complex_kind; extern int gfc_c_int_kind; +extern int gfc_atomic_int_kind; +extern int gfc_atomic_logical_kind; extern int gfc_intio_kind; extern int gfc_charlen_int_kind; extern int gfc_numeric_storage_size; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 6151db77eda..1cce1447b04 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -51,7 +51,7 @@ sizing; enum klass { CLASS_IMPURE = 0, CLASS_PURE, CLASS_ELEMENTAL, - CLASS_INQUIRY, CLASS_TRANSFORMATIONAL }; + CLASS_INQUIRY, CLASS_TRANSFORMATIONAL, CLASS_ATOMIC }; #define ACTUAL_NO 0 #define ACTUAL_YES 1 @@ -2880,6 +2880,18 @@ add_subroutines (void) make_noreturn(); + add_sym_2s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC, + BT_UNKNOWN, 0, GFC_STD_F2008, + gfc_check_atomic_def, NULL, gfc_resolve_atomic_def, + "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT, + "value", BT_INTEGER, di, REQUIRED, INTENT_IN); + + add_sym_2s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC, + BT_UNKNOWN, 0, GFC_STD_F2008, + gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref, + "value", BT_INTEGER, di, REQUIRED, INTENT_OUT, + "atom", BT_INTEGER, di, REQUIRED, INTENT_IN); + add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time, tm, BT_REAL, dr, REQUIRED, INTENT_OUT); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 88ce0084856..e64325b99e7 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -39,6 +39,8 @@ gfc_try gfc_check_allocated (gfc_expr *); gfc_try gfc_check_associated (gfc_expr *, gfc_expr *); gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *); gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *); +gfc_try gfc_check_atomic_def (gfc_expr *, gfc_expr *); +gfc_try gfc_check_atomic_ref (gfc_expr *, gfc_expr *); gfc_try gfc_check_besn (gfc_expr *, gfc_expr *); gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *); gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *); @@ -414,6 +416,8 @@ void gfc_resolve_asinh (gfc_expr *, gfc_expr *); void gfc_resolve_atan (gfc_expr *, gfc_expr *); void gfc_resolve_atanh (gfc_expr *, gfc_expr *); void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_atomic_def (gfc_code *); +void gfc_resolve_atomic_ref (gfc_code *); void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *a); void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 2ea4fc5271d..cb46a77e444 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -61,6 +61,8 @@ Some basic guidelines for editing this document: * @code{ATAN}: ATAN, Arctangent function * @code{ATAN2}: ATAN2, Arctangent function * @code{ATANH}: ATANH, Inverse hyperbolic tangent function +* @code{ATOMIC_DEFINE}: ATOMIC_DEFINE, Setting a variable atomically +* @code{ATOMIC_REF}: ATOMIC_REF, Obtaining the value of a variable atomically * @code{BESSEL_J0}: BESSEL_J0, Bessel function of the first kind of order 0 * @code{BESSEL_J1}: BESSEL_J1, Bessel function of the first kind of order 1 * @code{BESSEL_JN}: BESSEL_JN, Bessel function of the first kind @@ -1546,6 +1548,100 @@ Inverse function: @ref{TANH} +@node ATOMIC_DEFINE +@section @code{ATOMIC_DEFINE} --- Setting a variable atomically +@fnindex ATOMIC_DEFINE +@cindex Atomic subroutine, define + +@table @asis +@item @emph{Description}: +@code{ATOMIC_DEFINE(ATOM, VALUE)} defines the variable @var{ATOM} with the value +@var{VALUE} atomically. + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Atomic subroutine + +@item @emph{Syntax}: +@code{CALL ATOMIC_DEFINE(ATOM, VALUE)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{ATOM} @tab Scalar coarray or coindexed variable of either integer + type with @code{ATOMIC_INT_KIND} kind or logical type + with @code{ATOMIC_LOGICAL_KIND} kind. +@item @var{VALURE} @tab Scalar and of the same type as @var{ATOM}. If the kind + is different, the value is converted to the kind of + @var{ATOM}. +@end multitable + +@item @emph{Example}: +@smallexample +program atomic + use iso_fortran_env + integer(atomic_int_kind) :: atom[*] + call atomic_define (atom[1], this_image()) +end program atomic +@end smallexample + +@item @emph{See also}: +@ref{ATOMIC_REF}, @ref{ISO_FORTRAN_ENV} +@end table + + + +@node ATOMIC_REF +@section @code{ATOMIC_REF} --- Obtaining the value of a variable atomically +@fnindex ATOMIC_REF +@cindex Atomic subroutine, reference + +@table @asis +@item @emph{Description}: +@code{ATOMIC_DEFINE(ATOM, VALUE)} atomically assigns the value of the +variable @var{ATOM} to @var{VALUE}. + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Atomic subroutine + +@item @emph{Syntax}: +@code{CALL ATOMIC_REF(VALUE, ATOM)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{VALURE} @tab Scalar and of the same type as @var{ATOM}. If the kind + is different, the value is converted to the kind of + @var{ATOM}. +@item @var{ATOM} @tab Scalar coarray or coindexed variable of either integer + type with @code{ATOMIC_INT_KIND} kind or logical type + with @code{ATOMIC_LOGICAL_KIND} kind. +@end multitable + +@item @emph{Example}: +@smallexample +program atomic + use iso_fortran_env + logical(atomic_logical_kind) :: atom[*] + logical :: val + call atomic_ref (atom, .false.) + ! ... + call atomic_ref (atom, val) + if (val) then + print *, "Obtained" + end if +end program atomic +@end smallexample + +@item @emph{See also}: +@ref{ATOMIC_DEFINE}, @ref{ISO_FORTRAN_ENV} +@end table + + + @node BESSEL_J0 @section @code{BESSEL_J0} --- Bessel function of the first kind of order 0 @fnindex BESSEL_J0 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 24c9f76d7fe..9d94e3b9107 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2894,6 +2894,22 @@ create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints) } +void +gfc_resolve_atomic_def (gfc_code *c) +{ + const char *name = "atomic_define"; + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void +gfc_resolve_atomic_ref (gfc_code *c) +{ + const char *name = "atomic_ref"; + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + void gfc_resolve_mvbits (gfc_code *c) { diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def index 3586f076926..8ec70745e58 100644 --- a/gcc/fortran/iso-fortran-env.def +++ b/gcc/fortran/iso-fortran-env.def @@ -38,9 +38,9 @@ along with GCC; see the file COPYING3. If not see -- the standard that supports this type */ NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, "atomic_int_kind", \ - gfc_default_integer_kind, GFC_STD_F2008) + gfc_atomic_int_kind, GFC_STD_F2008) NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND, "atomic_logical_kind", \ - gfc_default_logical_kind, GFC_STD_F2008) + gfc_atomic_logical_kind, GFC_STD_F2008) NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \ gfc_character_storage_size, GFC_STD_F2003) NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER, \ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3cfaa0d4245..db2bbc14770 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6952,8 +6952,44 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, } -tree -gfc_conv_intrinsic_move_alloc (gfc_code *code) +static tree +conv_intrinsic_atomic_def (gfc_code *code) +{ + gfc_se atom, value; + stmtblock_t block; + + gfc_init_se (&atom, NULL); + gfc_init_se (&value, NULL); + gfc_conv_expr (&atom, code->ext.actual->expr); + gfc_conv_expr (&value, code->ext.actual->next->expr); + + gfc_init_block (&block); + gfc_add_modify (&block, atom.expr, + fold_convert (TREE_TYPE (atom.expr), value.expr)); + return gfc_finish_block (&block); +} + + +static tree +conv_intrinsic_atomic_ref (gfc_code *code) +{ + gfc_se atom, value; + stmtblock_t block; + + gfc_init_se (&atom, NULL); + gfc_init_se (&value, NULL); + gfc_conv_expr (&value, code->ext.actual->expr); + gfc_conv_expr (&atom, code->ext.actual->next->expr); + + gfc_init_block (&block); + gfc_add_modify (&block, value.expr, + fold_convert (TREE_TYPE (value.expr), atom.expr)); + return gfc_finish_block (&block); +} + + +static tree +conv_intrinsic_move_alloc (gfc_code *code) { if (code->ext.actual->expr->rank == 0) { @@ -7002,4 +7038,33 @@ gfc_conv_intrinsic_move_alloc (gfc_code *code) } +tree +gfc_conv_intrinsic_subroutine (gfc_code *code) +{ + tree res; + + gcc_assert (code->resolved_isym); + + switch (code->resolved_isym->id) + { + case GFC_ISYM_MOVE_ALLOC: + res = conv_intrinsic_move_alloc (code); + break; + + case GFC_ISYM_ATOMIC_DEF: + res = conv_intrinsic_atomic_def (code); + break; + + case GFC_ISYM_ATOMIC_REF: + res = conv_intrinsic_atomic_ref (code); + break; + + default: + res = NULL_TREE; + break; + } + + return res; +} + #include "gt-fortran-trans-intrinsic.h" diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 02a75fd2819..6d384bedf16 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -118,6 +118,8 @@ int gfc_default_character_kind; int gfc_default_logical_kind; int gfc_default_complex_kind; int gfc_c_int_kind; +int gfc_atomic_int_kind; +int gfc_atomic_logical_kind; /* The kind size used for record offsets. If the target system supports kind=8, this will be set to 8, otherwise it is set to 4. */ @@ -578,6 +580,10 @@ gfc_init_kinds (void) /* Pick a kind the same size as the C "int" type. */ gfc_c_int_kind = INT_TYPE_SIZE / 8; + /* Choose atomic kinds to match C's int. */ + gfc_atomic_int_kind = gfc_c_int_kind; + gfc_atomic_logical_kind = gfc_c_int_kind; + /* initialize the C interoperable kinds */ init_c_interop_kinds(); } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 0ab4637851c..f2f13525b39 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1245,15 +1245,20 @@ trans_code (gfc_code * code, tree cond) dependency check, too. */ { bool is_mvbits = false; + + if (code->resolved_isym) + { + res = gfc_conv_intrinsic_subroutine (code); + if (res != NULL_TREE) + break; + } + if (code->resolved_isym && code->resolved_isym->id == GFC_ISYM_MVBITS) is_mvbits = true; - if (code->resolved_isym - && code->resolved_isym->id == GFC_ISYM_MOVE_ALLOC) - res = gfc_conv_intrinsic_move_alloc (code); - else - res = gfc_trans_call (code, is_mvbits, NULL_TREE, - NULL_TREE, false); + + res = gfc_trans_call (code, is_mvbits, NULL_TREE, + NULL_TREE, false); } break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 95cd9fbf151..e14e41f8a25 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -345,7 +345,8 @@ tree gfc_evaluate_now (tree, stmtblock_t *); /* Find the appropriate variant of a math intrinsic. */ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); -/* Intrinsic function handling. */ +/* Intrinsic procedure handling. */ +tree gfc_conv_intrinsic_subroutine (gfc_code *); void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); /* Is the intrinsic expanded inline. */ @@ -356,8 +357,6 @@ bool gfc_inline_intrinsic_function_p (gfc_expr *); gfc_inline_intrinsic_function_p returns true. */ int gfc_is_intrinsic_libcall (gfc_expr *); -tree gfc_conv_intrinsic_move_alloc (gfc_code *); - /* Used to call ordinary functions/subroutines and procedure pointer components. */ int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 85c4a371c74..f8eea2b32e6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-05-31 Tobias Burnus + + PR fortran/18918 + * gfortran.dg/coarray_atomic_1.f90: New. + * gfortran.dg/coarray/atomic_1.f90: New. + 2011-05-31 Jakub Jelinek * gcc.dg/guality/bswaptest.c: New test. diff --git a/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 b/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 new file mode 100644 index 00000000000..1cf621287a6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! +! PR fortran/18918 +! +! Basic atomic def/ref test +! + +use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind +implicit none +integer(atomic_int_kind) :: a(1)[*] +logical(atomic_logical_kind) :: c[*] +intrinsic :: atomic_define +intrinsic :: atomic_ref +integer(8) :: b +logical(1) :: d + +call atomic_define(a(1), 7_2) +call atomic_ref(b, a(1)) +if (b /= a(1)) call abort() + +call atomic_define(c, .false.) +call atomic_ref(d, c[this_image()]) +if (d .neqv. .false.) call abort() +call atomic_define(c[this_image()], .true.) +call atomic_ref(d, c) +if (d .neqv. .true.) call abort() +end diff --git a/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 b/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 new file mode 100644 index 00000000000..bf94b914cb7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single -std=f2008" } +! +! PR fortran/18918 +! +! Diagnostic for atomic subroutines +! +use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind +implicit none +integer(atomic_int_kind) :: a(1)[*] +logical(1) :: c[*] +integer(atomic_int_kind) :: b +logical(atomic_logical_kind) :: d, e[*] + +call atomic_define(a, 7_2) ! { dg-error "must be a scalar" } +call atomic_ref(b, b) ! { dg-error "shall be a coarray" } + +call atomic_define(c, 7) ! { dg-error "an integer of ATOMIC_INT_KIND or a logical of ATOMIC_LOGICAL_KIND" } +call atomic_ref(d, a(1)) ! { dg-error "shall have the same type" } +call atomic_ref(.true., e) ! { dg-error "shall be definable" } +end