This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
RE: Fwd: DEC Extension Patches: Structure, Union, and Map
- From: Fritz Reese <fritzoreese at gmail dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Tue, 1 Mar 2016 16:18:06 -0500
- Subject: RE: Fwd: DEC Extension Patches: Structure, Union, and Map
- Authentication-results: sourceware.org; auth=none
Please see the original thread
https://gcc.gnu.org/ml/fortran/2016-03/msg00002.html.
I have to send the patches separately, as together they cause me to be
blocked for spamming. This is patch 3:
---
Fritz Reese
From 93e96b8a9e62c0413e6d9d33c01fa7825ecd9ee4 Mon Sep 17 00:00:00 2001
From: Fritz O. Reese <fritzoreese@gmail.com>
Date: Thu, 13 Nov 2014 14:41:04 -0500
Subject: [PATCH 3/4] 2014-11-13 Fritz Reese <fritzoreese@gmail.com>
gcc/fortran/
* parse.c (check_component): New function.
(parse_derived): Move loop code to check_component.
---
gcc/fortran/parse.c | 343 +++++++++++++++++++++++++++------------------------
1 files changed, 179 insertions(+), 164 deletions(-)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7bce47f..1374c13 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2646,6 +2646,184 @@ error:
}
+/* Set attributes for the parent symbol based on the attributes of a component
+ and raise errors if conflicting attributes are found for the component. */
+
+static void
+check_component (gfc_symbol *sym, gfc_component *c, gfc_component **lockp,
+ gfc_component **eventp)
+{
+ bool coarray, lock_type, event_type, allocatable, pointer;
+ coarray = lock_type = event_type = allocatable = pointer = false;
+ gfc_component *lock_comp, *event_comp;
+
+ lock_comp = *lockp;
+ event_comp = *eventp;
+
+ /* Look for allocatable components. */
+ if (c->attr.allocatable
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.allocatable)
+ || (c->ts.type == BT_DERIVED && !c->attr.pointer
+ && c->ts.u.derived->attr.alloc_comp))
+ {
+ allocatable = true;
+ sym->attr.alloc_comp = 1;
+ }
+
+ /* Look for pointer components. */
+ if (c->attr.pointer
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.class_pointer)
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
+ {
+ pointer = true;
+ sym->attr.pointer_comp = 1;
+ }
+
+ /* Look for procedure pointer components. */
+ if (c->attr.proc_pointer
+ || (c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.proc_pointer_comp))
+ sym->attr.proc_pointer_comp = 1;
+
+ /* Looking for coarray components. */
+ if (c->attr.codimension
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.codimension))
+ {
+ coarray = true;
+ sym->attr.coarray_comp = 1;
+ }
+
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
+ && !c->attr.pointer)
+ {
+ coarray = true;
+ sym->attr.coarray_comp = 1;
+ }
+
+ /* Looking for lock_type components. */
+ if ((c->ts.type == BT_DERIVED
+ && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+ && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->ts.u.derived->from_intmod
+ == INTMOD_ISO_FORTRAN_ENV
+ && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
+ == ISOFORTRAN_LOCK_TYPE)
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp
+ && !allocatable && !pointer))
+ {
+ lock_type = 1;
+ lock_comp = c;
+ sym->attr.lock_comp = 1;
+ }
+
+ /* Looking for event_type components. */
+ if ((c->ts.type == BT_DERIVED
+ && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+ && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+ || (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->ts.u.derived->from_intmod
+ == INTMOD_ISO_FORTRAN_ENV
+ && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
+ == ISOFORTRAN_EVENT_TYPE)
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.event_comp
+ && !allocatable && !pointer))
+ {
+ event_type = 1;
+ event_comp = c;
+ sym->attr.event_comp = 1;
+ }
+
+ /* Check for F2008, C1302 - and recall that pointers may not be coarrays
+ (5.3.14) and that subobjects of coarray are coarray themselves (2.4.7),
+ unless there are nondirect [allocatable or pointer] components
+ involved (cf. 1.3.33.1 and 1.3.33.3). */
+
+ if (pointer && !coarray && lock_type)
+ gfc_error ("Component %s at %L of type LOCK_TYPE must have a "
+ "codimension or be a subcomponent of a coarray, "
+ "which is not possible as the component has the "
+ "pointer attribute", c->name, &c->loc);
+ else if (pointer && !coarray && c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.lock_comp)
+ gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
+ "of type LOCK_TYPE, which must have a codimension or be a "
+ "subcomponent of a coarray", c->name, &c->loc);
+
+ if (lock_type && allocatable && !coarray)
+ gfc_error ("Allocatable component %s at %L of type LOCK_TYPE must have "
+ "a codimension", c->name, &c->loc);
+ else if (lock_type && allocatable && c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.lock_comp)
+ gfc_error ("Allocatable component %s at %L must have a codimension as "
+ "it has a noncoarray subcomponent of type LOCK_TYPE",
+ c->name, &c->loc);
+
+ if (sym->attr.coarray_comp && !coarray && lock_type)
+ gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+ "subcomponent of type LOCK_TYPE must have a codimension or "
+ "be a subcomponent of a coarray. (Variables of type %s may "
+ "not have a codimension as already a coarray "
+ "subcomponent exists)", c->name, &c->loc, sym->name);
+
+ if (sym->attr.lock_comp && coarray && !lock_type)
+ gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+ "subcomponent of type LOCK_TYPE must have a codimension or "
+ "be a subcomponent of a coarray. (Variables of type %s may "
+ "not have a codimension as %s at %L has a codimension or a "
+ "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
+ sym->name, c->name, &c->loc);
+
+ /* Similarly for EVENT TYPE. */
+
+ if (pointer && !coarray && event_type)
+ gfc_error ("Component %s at %L of type EVENT_TYPE must have a "
+ "codimension or be a subcomponent of a coarray, "
+ "which is not possible as the component has the "
+ "pointer attribute", c->name, &c->loc);
+ else if (pointer && !coarray && c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.event_comp)
+ gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
+ "of type EVENT_TYPE, which must have a codimension or be a "
+ "subcomponent of a coarray", c->name, &c->loc);
+
+ if (event_type && allocatable && !coarray)
+ gfc_error ("Allocatable component %s at %L of type EVENT_TYPE must have "
+ "a codimension", c->name, &c->loc);
+ else if (event_type && allocatable && c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.event_comp)
+ gfc_error ("Allocatable component %s at %L must have a codimension as "
+ "it has a noncoarray subcomponent of type EVENT_TYPE",
+ c->name, &c->loc);
+
+ if (sym->attr.coarray_comp && !coarray && event_type)
+ gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
+ "subcomponent of type EVENT_TYPE must have a codimension or "
+ "be a subcomponent of a coarray. (Variables of type %s may "
+ "not have a codimension as already a coarray "
+ "subcomponent exists)", c->name, &c->loc, sym->name);
+
+ if (sym->attr.event_comp && coarray && !event_type)
+ gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
+ "subcomponent of type EVENT_TYPE must have a codimension or "
+ "be a subcomponent of a coarray. (Variables of type %s may "
+ "not have a codimension as %s at %L has a codimension or a "
+ "coarray subcomponent)", event_comp->name, &event_comp->loc,
+ sym->name, c->name, &c->loc);
+
+ /* Look for private components. */
+ if (sym->component_access == ACCESS_PRIVATE
+ || c->attr.access == ACCESS_PRIVATE
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))
+ sym->attr.private_comp = 1;
+
+ *lockp = lock_comp;
+ *eventp = event_comp;
+}
+
/* Parse a derived type. */
static void
@@ -2762,170 +2940,7 @@ endType:
*/
sym = gfc_current_block ();
for (c = sym->components; c; c = c->next)
- {
- bool coarray, lock_type, event_type, allocatable, pointer;
- coarray = lock_type = event_type = allocatable = pointer = false;
-
- /* Look for allocatable components. */
- if (c->attr.allocatable
- || (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->attr.allocatable)
- || (c->ts.type == BT_DERIVED && !c->attr.pointer
- && c->ts.u.derived->attr.alloc_comp))
- {
- allocatable = true;
- sym->attr.alloc_comp = 1;
- }
-
- /* Look for pointer components. */
- if (c->attr.pointer
- || (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->attr.class_pointer)
- || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
- {
- pointer = true;
- sym->attr.pointer_comp = 1;
- }
-
- /* Look for procedure pointer components. */
- if (c->attr.proc_pointer
- || (c->ts.type == BT_DERIVED
- && c->ts.u.derived->attr.proc_pointer_comp))
- sym->attr.proc_pointer_comp = 1;
-
- /* Looking for coarray components. */
- if (c->attr.codimension
- || (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->attr.codimension))
- {
- coarray = true;
- sym->attr.coarray_comp = 1;
- }
-
- if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
- && !c->attr.pointer)
- {
- coarray = true;
- sym->attr.coarray_comp = 1;
- }
-
- /* Looking for lock_type components. */
- if ((c->ts.type == BT_DERIVED
- && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
- && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
- || (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->ts.u.derived->from_intmod
- == INTMOD_ISO_FORTRAN_ENV
- && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
- == ISOFORTRAN_LOCK_TYPE)
- || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp
- && !allocatable && !pointer))
- {
- lock_type = 1;
- lock_comp = c;
- sym->attr.lock_comp = 1;
- }
-
- /* Looking for event_type components. */
- if ((c->ts.type == BT_DERIVED
- && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
- && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
- || (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->ts.u.derived->from_intmod
- == INTMOD_ISO_FORTRAN_ENV
- && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
- == ISOFORTRAN_EVENT_TYPE)
- || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.event_comp
- && !allocatable && !pointer))
- {
- event_type = 1;
- event_comp = c;
- sym->attr.event_comp = 1;
- }
-
- /* Check for F2008, C1302 - and recall that pointers may not be coarrays
- (5.3.14) and that subobjects of coarray are coarray themselves (2.4.7),
- unless there are nondirect [allocatable or pointer] components
- involved (cf. 1.3.33.1 and 1.3.33.3). */
-
- if (pointer && !coarray && lock_type)
- gfc_error ("Component %s at %L of type LOCK_TYPE must have a "
- "codimension or be a subcomponent of a coarray, "
- "which is not possible as the component has the "
- "pointer attribute", c->name, &c->loc);
- else if (pointer && !coarray && c->ts.type == BT_DERIVED
- && c->ts.u.derived->attr.lock_comp)
- gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
- "of type LOCK_TYPE, which must have a codimension or be a "
- "subcomponent of a coarray", c->name, &c->loc);
-
- if (lock_type && allocatable && !coarray)
- gfc_error ("Allocatable component %s at %L of type LOCK_TYPE must have "
- "a codimension", c->name, &c->loc);
- else if (lock_type && allocatable && c->ts.type == BT_DERIVED
- && c->ts.u.derived->attr.lock_comp)
- gfc_error ("Allocatable component %s at %L must have a codimension as "
- "it has a noncoarray subcomponent of type LOCK_TYPE",
- c->name, &c->loc);
-
- if (sym->attr.coarray_comp && !coarray && lock_type)
- gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
- "subcomponent of type LOCK_TYPE must have a codimension or "
- "be a subcomponent of a coarray. (Variables of type %s may "
- "not have a codimension as already a coarray "
- "subcomponent exists)", c->name, &c->loc, sym->name);
-
- if (sym->attr.lock_comp && coarray && !lock_type)
- gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
- "subcomponent of type LOCK_TYPE must have a codimension or "
- "be a subcomponent of a coarray. (Variables of type %s may "
- "not have a codimension as %s at %L has a codimension or a "
- "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
- sym->name, c->name, &c->loc);
-
- /* Similarly for EVENT TYPE. */
-
- if (pointer && !coarray && event_type)
- gfc_error ("Component %s at %L of type EVENT_TYPE must have a "
- "codimension or be a subcomponent of a coarray, "
- "which is not possible as the component has the "
- "pointer attribute", c->name, &c->loc);
- else if (pointer && !coarray && c->ts.type == BT_DERIVED
- && c->ts.u.derived->attr.event_comp)
- gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
- "of type EVENT_TYPE, which must have a codimension or be a "
- "subcomponent of a coarray", c->name, &c->loc);
-
- if (event_type && allocatable && !coarray)
- gfc_error ("Allocatable component %s at %L of type EVENT_TYPE must have "
- "a codimension", c->name, &c->loc);
- else if (event_type && allocatable && c->ts.type == BT_DERIVED
- && c->ts.u.derived->attr.event_comp)
- gfc_error ("Allocatable component %s at %L must have a codimension as "
- "it has a noncoarray subcomponent of type EVENT_TYPE",
- c->name, &c->loc);
-
- if (sym->attr.coarray_comp && !coarray && event_type)
- gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
- "subcomponent of type EVENT_TYPE must have a codimension or "
- "be a subcomponent of a coarray. (Variables of type %s may "
- "not have a codimension as already a coarray "
- "subcomponent exists)", c->name, &c->loc, sym->name);
-
- if (sym->attr.event_comp && coarray && !event_type)
- gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
- "subcomponent of type EVENT_TYPE must have a codimension or "
- "be a subcomponent of a coarray. (Variables of type %s may "
- "not have a codimension as %s at %L has a codimension or a "
- "coarray subcomponent)", event_comp->name, &event_comp->loc,
- sym->name, c->name, &c->loc);
-
- /* Look for private components. */
- if (sym->component_access == ACCESS_PRIVATE
- || c->attr.access == ACCESS_PRIVATE
- || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))
- sym->attr.private_comp = 1;
- }
+ check_component (sym, c, &lock_comp, &event_comp);
if (!seen_component)
sym->attr.zero_comp = 1;
--
1.7.1