aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/symbol.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/symbol.c')
-rw-r--r--gcc/fortran/symbol.c33
1 files changed, 32 insertions, 1 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 8ba5adb..750aa2d 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -369,7 +369,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
*use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
*cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
*volatile_ = "VOLATILE", *is_protected = "PROTECTED",
- *is_bind_c = "BIND(C)", *procedure = "PROCEDURE";
+ *is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
+ *asynchronous = "ASYNCHRONOUS";
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
@@ -559,6 +560,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (is_protected, external)
conf (is_protected, in_common)
+ conf (asynchronous, intrinsic)
+ conf (asynchronous, external)
+
conf (volatile_, intrinsic)
conf (volatile_, external)
@@ -576,6 +580,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (procedure, target)
conf (procedure, value)
conf (procedure, volatile_)
+ conf (procedure, asynchronous)
conf (procedure, entry)
a1 = gfc_code2string (flavors, attr->flavor);
@@ -598,6 +603,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (dimension);
conf2 (dummy);
conf2 (volatile_);
+ conf2 (asynchronous);
conf2 (pointer);
conf2 (is_protected);
conf2 (target);
@@ -640,8 +646,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
if (attr->subroutine)
{
+ a1 = subroutine;
conf2 (target);
conf2 (allocatable);
+ conf2 (volatile_);
+ conf2 (asynchronous);
conf2 (in_namelist);
conf2 (dimension);
conf2 (function);
@@ -708,6 +717,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (in_common);
conf2 (value);
conf2 (volatile_);
+ conf2 (asynchronous);
conf2 (threadprivate);
conf2 (value);
conf2 (is_bind_c);
@@ -1100,6 +1110,25 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
gfc_try
+gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
+{
+ /* No check_used needed as 11.2.1 of the F2003 standard allows
+ that the local identifier made accessible by a use statement can be
+ given a ASYNCHRONOUS attribute. */
+
+ if (attr->asynchronous && attr->asynchronous_ns == gfc_current_ns)
+ if (gfc_notify_std (GFC_STD_LEGACY,
+ "Duplicate ASYNCHRONOUS attribute specified at %L",
+ where) == FAILURE)
+ return FAILURE;
+
+ attr->asynchronous = 1;
+ attr->asynchronous_ns = gfc_current_ns;
+ return check_conflict (attr, name, where);
+}
+
+
+gfc_try
gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
{
@@ -1659,6 +1688,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
goto fail;
if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
goto fail;
+ if (src->asynchronous && gfc_add_asynchronous (dest, NULL, where) == FAILURE)
+ goto fail;
if (src->threadprivate
&& gfc_add_threadprivate (dest, NULL, where) == FAILURE)
goto fail;