aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/decl.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/decl.c')
-rw-r--r--gcc/fortran/decl.c88
1 files changed, 75 insertions, 13 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 9237503..b376192 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1057,6 +1057,7 @@ build_sym (const char *name, gfc_charlen *cl,
dimension attribute. */
attr = current_attr;
attr.dimension = 0;
+ attr.codimension = 0;
if (gfc_copy_attr (&sym->attr, &attr, var_locus) == FAILURE)
return FAILURE;
@@ -1430,7 +1431,12 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
c->as = *as;
if (c->as != NULL)
- c->attr.dimension = 1;
+ {
+ if (c->as->corank)
+ c->attr.codimension = 1;
+ if (c->as->rank)
+ c->attr.dimension = 1;
+ }
*as = NULL;
/* Should this ever get more complicated, combine with similar section
@@ -1589,7 +1595,7 @@ variable_decl (int elem)
var_locus = gfc_current_locus;
/* Now we could see the optional array spec. or character length. */
- m = gfc_match_array_spec (&as);
+ m = gfc_match_array_spec (&as, true, true);
if (gfc_option.flag_cray_pointer && m == MATCH_YES)
cp_as = gfc_copy_array_spec (as);
else if (m == MATCH_ERROR)
@@ -2820,7 +2826,7 @@ match_attr_spec (void)
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
- DECL_IS_BIND_C, DECL_ASYNCHRONOUS, DECL_NONE,
+ DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_NONE,
GFC_DECL_END /* Sentinel */
}
decl_types;
@@ -2894,6 +2900,11 @@ match_attr_spec (void)
goto cleanup;
break;
+ case 'c':
+ if (match_string_p ("codimension"))
+ d = DECL_CODIMENSION;
+ break;
+
case 'd':
if (match_string_p ("dimension"))
d = DECL_DIMENSION;
@@ -3041,7 +3052,7 @@ match_attr_spec (void)
if (d == DECL_DIMENSION)
{
- m = gfc_match_array_spec (&current_as);
+ m = gfc_match_array_spec (&current_as, true, false);
if (m == MATCH_NO)
{
@@ -3052,6 +3063,20 @@ match_attr_spec (void)
if (m == MATCH_ERROR)
goto cleanup;
}
+
+ if (d == DECL_CODIMENSION)
+ {
+ m = gfc_match_array_spec (&current_as, false, true);
+
+ if (m == MATCH_NO)
+ {
+ gfc_error ("Missing codimension specification at %C");
+ m = MATCH_ERROR;
+ }
+
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ }
}
/* Since we've seen a double colon, we have to be looking at an
@@ -3067,6 +3092,9 @@ match_attr_spec (void)
case DECL_ASYNCHRONOUS:
attr = "ASYNCHRONOUS";
break;
+ case DECL_CODIMENSION:
+ attr = "CODIMENSION";
+ break;
case DECL_DIMENSION:
attr = "DIMENSION";
break;
@@ -3135,9 +3163,9 @@ match_attr_spec (void)
continue;
if (gfc_current_state () == COMP_DERIVED
- && d != DECL_DIMENSION && d != DECL_POINTER
- && d != DECL_PRIVATE && d != DECL_PUBLIC
- && d != DECL_NONE)
+ && d != DECL_DIMENSION && d != DECL_CODIMENSION
+ && d != DECL_POINTER && d != DECL_PRIVATE
+ && d != DECL_PUBLIC && d != DECL_NONE)
{
if (d == DECL_ALLOCATABLE)
{
@@ -3202,6 +3230,10 @@ match_attr_spec (void)
t = gfc_add_asynchronous (&current_attr, NULL, &seen_at[d]);
break;
+ case DECL_CODIMENSION:
+ t = gfc_add_codimension (&current_attr, NULL, &seen_at[d]);
+ break;
+
case DECL_DIMENSION:
t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
break;
@@ -5626,11 +5658,15 @@ attr_decl1 (void)
/* Deal with possible array specification for certain attributes. */
if (current_attr.dimension
+ || current_attr.codimension
|| current_attr.allocatable
|| current_attr.pointer
|| current_attr.target)
{
- m = gfc_match_array_spec (&as);
+ m = gfc_match_array_spec (&as, !current_attr.codimension,
+ !current_attr.dimension
+ && !current_attr.pointer
+ && !current_attr.target);
if (m == MATCH_ERROR)
goto cleanup;
@@ -5650,6 +5686,14 @@ attr_decl1 (void)
goto cleanup;
}
+ if (current_attr.codimension && m == MATCH_NO)
+ {
+ gfc_error ("Missing array specification at %L in CODIMENSION "
+ "statement", &var_locus);
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+
if ((current_attr.allocatable || current_attr.pointer)
&& (m == MATCH_YES) && (as->type != AS_DEFERRED))
{
@@ -5678,8 +5722,8 @@ attr_decl1 (void)
}
else
{
- if (current_attr.dimension == 0
- && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
+ if (current_attr.dimension == 0 && current_attr.codimension == 0
+ && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
@@ -5777,7 +5821,7 @@ static match
cray_pointer_decl (void)
{
match m;
- gfc_array_spec *as;
+ gfc_array_spec *as = NULL;
gfc_symbol *cptr; /* Pointer symbol. */
gfc_symbol *cpte; /* Pointee symbol. */
locus var_locus;
@@ -5846,7 +5890,7 @@ cray_pointer_decl (void)
}
/* Check for an optional array spec. */
- m = gfc_match_array_spec (&as);
+ m = gfc_match_array_spec (&as, true, false);
if (m == MATCH_ERROR)
{
gfc_free_array_spec (as);
@@ -6006,6 +6050,16 @@ gfc_match_allocatable (void)
match
+gfc_match_codimension (void)
+{
+ gfc_clear_attr (&current_attr);
+ current_attr.codimension = 1;
+
+ return attr_decl ();
+}
+
+
+match
gfc_match_dimension (void)
{
gfc_clear_attr (&current_attr);
@@ -6493,11 +6547,19 @@ gfc_match_volatile (void)
for(;;)
{
/* VOLATILE is special because it can be added to host-associated
- symbols locally. */
+ symbols locally. Except for coarrays. */
m = gfc_match_symbol (&sym, 1);
switch (m)
{
case MATCH_YES:
+ /* F2008, C560+C561. VOLATILE for host-/use-associated variable or
+ for variable in a BLOCK which is defined outside of the BLOCK. */
+ if (sym->ns != gfc_current_ns && sym->attr.codimension)
+ {
+ gfc_error ("Specifying VOLATILE for coarray variable '%s' at "
+ "%C, which is use-/host-associated", sym->name);
+ return MATCH_ERROR;
+ }
if (gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus)
== FAILURE)
return MATCH_ERROR;
generated by cgit v1.1 at 2025-06-02 14:43:22 +0000