re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

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

1 files changed, 66 insertions, 0 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 70c23e6..1178967 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