From: Fritz Reese <fritzoreese@gmail.com>
To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org
Subject: RE: Fwd: DEC Extension Patches: Structure, Union, and Map
Date: Tue, 01 Mar 2016 21:18:00 -0000 [thread overview]
Message-ID: <CAE4aFA=C2909sYOXmjE6ZVYw1zAqPbUrzZfbFx9rHmbHoQSOkw@mail.gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 214 bytes --]
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
[-- Attachment #2: 0003-2014-11-13-Fritz-Reese-fritzoreese-gmail.com.patch --]
[-- Type: text/x-patch, Size: 15598 bytes --]
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
next reply other threads:[~2016-03-01 21:18 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-03-01 21:18 Fritz Reese [this message]
-- strict thread matches above, loose matches on Subject: below --
2016-05-10 22:34 Dominique d'Humières
2016-05-13 0:15 ` Fritz Reese
2016-05-14 20:01 ` Steve Kargl
2016-03-01 21:25 Fritz Reese
2016-03-01 21:17 Fritz Reese
2016-03-01 21:12 Fritz Reese
[not found] <CAE4aFAn4fv4G3qgYrJr-476dgAYjTeG=LEtzbzYZ_dz8WVme4A@mail.gmail.com>
[not found] ` <CAE4aFAnVnTufXz6aVsjnvv_WBEkETWgDtRFJNxwnuZa39iiqfQ@mail.gmail.com>
[not found] ` <CAE4aFAmvOxARXxx2Z=kPxnXGmAfdZed0HAt_D9UVEm6OrHX50w@mail.gmail.com>
2016-03-01 21:07 ` Fritz Reese
2016-03-02 0:25 ` Steve Kargl
2016-03-02 6:52 ` Paul Richard Thomas
2016-03-06 12:17 ` Paul Richard Thomas
2016-03-08 8:49 ` Paul Richard Thomas
2016-03-03 14:31 ` Jim MacArthur
2016-05-07 23:22 ` Steve Kargl
2016-05-10 17:37 ` Jerry DeLisle
2016-05-11 7:00 ` Paul Richard Thomas
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAE4aFA=C2909sYOXmjE6ZVYw1zAqPbUrzZfbFx9rHmbHoQSOkw@mail.gmail.com' \
--to=fritzoreese@gmail.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).