Patchwork [Fortran] -fcoarray=single implementation of the atomic subroutines

login
register
mail settings
Submitter Tobias Burnus
Date May 31, 2011, 4:24 p.m.
Message ID <4DE51621.8070707@net-b.de>
Download mbox | patch
Permalink /patch/98058/
State New
Headers show

Comments

Tobias Burnus - May 31, 2011, 4:24 p.m.
This patch adds the atomic_define and atomic_ref intrinsics. They are 
currently implemented in form a simple assignment. For -fcoarray=lib 
they will be replaced by a function call to libcaf_{single,mpi,*}.

I was shortly thinking of using something more clever, but I concluded 
that a simple assignment should be sufficiently atomic (for 
-fcoarray=single).

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
Daniel Kraft - May 31, 2011, 4:37 p.m.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Hi,

On 05/31/11 18:24, Tobias Burnus wrote:
> This patch adds the atomic_define and atomic_ref intrinsics. They are
> currently implemented in form a simple assignment. For -fcoarray=lib
> they will be replaced by a function call to libcaf_{single,mpi,*}.
> 
> I was shortly thinking of using something more clever, but I concluded
> that a simple assignment should be sufficiently atomic (for
> -fcoarray=single).
> 
> Build and regtested on x86-64-linux.
> OK for the trunk?

Ok.  Just one thought:

+  if (!(atom->ts.type == BT_INTEGER && atom->ts.kind == gfc_c_int_kind)
+      && !(atom->ts.type == BT_LOGICAL && atom->ts.kind == gfc_c_int_kind))

What about defining another constant for atomic_int_kind rather than
gfc_c_int_kind, in case we want to change this in the future?  Or is it
clear that we indeed *always* want atomic_int_kind to be c_int_kind?

Yours,
Daniel
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.2.1 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/

iQIVAwUBTeUZOlJ+ebqjtTmYAQLJyw//YT4NNnyxw5xv0e5ytBe5ec2NSInQt1w8
iTrKxHVhtTI7mJGVPae0wYLhLMm95pZ2I6Mp0ExFDT2Mnugw9QdGG1z2U4Hdbns3
qFdMhc2ub5ZtqlpLevojqJOM+Cz8b7nUJtczc8qY9tNC8r1ybQBOFfJEfPeBytVA
BzysrOSx7rkuSQScRrr8S5e1NY1e4Mf2nLDvLlgdWpzSgBmm9At3CvZPASnskIxB
DNMcCwWKuoRHTLOLMZEgrBp65vr1tNf7IHe0Z0Kmi7UgEvsrs7NwDvvRczBoLa2v
cueVRU4ZMU+qNhNqM2QL1pYED0QEMrcHzshq2xt7r3p1XCKNhQeJlNg/Cpucs8a3
e+E9uAtNDJLVwCE/v71Vy8zXt5kr+fNDr/N2vEM0iJaqfzeUz5PI7uxy5wvoI5Oq
ktuHxM9b7Ev8DtFJym5opLzYBTLA36F+H8zFtMfBwGnmuaNRGPqUUU7j/XBIAb3E
DjRXq7FbRwIObPz06SQ4F3peG8abegs8+guqNw4V4ZKeWDU4fZhRsutLCnSi/jj1
94n1hWp1sf4gwWk3aK/90JXuQxAnnOz4VIskymuFwr8ZlnnX5+S62t8sYLRRL/BC
FyJofN/uDyZ/0cbrVggAJtXHK29EGli/lPX7PYPiGpDkEvAB0auWjNI+EvPZS/gc
Nr7b+g16vUI=
=fYF2
-----END PGP SIGNATURE-----

Patch

 b/gcc/fortran/check.c                              |   65 ++++++++++++++
 b/gcc/fortran/gfortran.h                           |    2
 b/gcc/fortran/intrinsic.c                          |   16 +++
 b/gcc/fortran/intrinsic.h                          |    4
 b/gcc/fortran/intrinsic.texi                       |   96 +++++++++++++++++++++
 b/gcc/fortran/iresolve.c                           |   16 +++
 b/gcc/fortran/iso-fortran-env.def                  |    4
 b/gcc/fortran/trans-intrinsic.c                    |   68 ++++++++++++++
 b/gcc/fortran/trans.c                              |   17 ++-
 b/gcc/fortran/trans.h                              |    5 -
 gcc/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 |   27 +++++
 gcc/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 |   21 ++++
 12 files changed, 326 insertions(+), 15 deletions(-)


2011-05-31  Tobias Burnus  <burnus@net-b.de>

	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.
	* 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.

2011-05-31  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* gfortran.dg/coarray_atomic_1.f90: New.
	* gfortran.dg/coarray/atomic_1.f90: New.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 70c23e6..0e6b2d8 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -973,6 +973,71 @@  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_c_int_kind)
+      && !(atom->ts.type == BT_LOGICAL && atom->ts.kind == gfc_c_int_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 72e412b..b2b2e84 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,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 6151db7..c6d958f 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 88ce008..e64325b 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 2ea4fc5..cb46a77 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 24c9f76..9d94e3b 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2895,6 +2895,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)
 {
   static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN,
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
index 3586f07..a4d4c6a 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_c_int_kind, GFC_STD_F2008)
 NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND, "atomic_logical_kind", \
-              gfc_default_logical_kind, GFC_STD_F2008)
+              gfc_c_int_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 3cfaa0d..d6c5ae1 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,32 @@  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);
+
+    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.c b/gcc/fortran/trans.c
index 0ab4637..f2f1352 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 95cd9fb..e14e41f 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 *,
--- /dev/null	2011-05-31 07:23:47.047892583 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90	2011-05-31 18:06:21.000000000 +0200
@@ -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
--- /dev/null	2011-05-31 07:23:47.047892583 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90	2011-05-31 17:30:32.000000000 +0200
@@ -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