diff options
Diffstat (limited to 'gcc/fortran/symbol.c')
-rw-r--r-- | gcc/fortran/symbol.c | 33 |
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; |