* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
@ 2016-05-10 22:34 Dominique d'Humières
2016-05-13 0:15 ` Fritz Reese
0 siblings, 1 reply; 16+ messages in thread
From: Dominique d'Humières @ 2016-05-10 22:34 UTC (permalink / raw)
To: Steve Kargl; +Cc: fritzoreese, fortran
> Please keep an eye out for people reporting problems.
It caused pr71047.
> I'll commit the patch to the 6-branch next weekend as I am traveling
> for the next week.
Could you please wait for a fix?
TIA
Dominique
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-05-10 22:34 Fwd: DEC Extension Patches: Structure, Union, and Map Dominique d'Humières
@ 2016-05-13 0:15 ` Fritz Reese
2016-05-14 20:01 ` Steve Kargl
0 siblings, 1 reply; 16+ messages in thread
From: Fritz Reese @ 2016-05-13 0:15 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: Steve Kargl, fortran
On Tue, May 10, 2016 at 6:34 PM, Dominique d'Humières
<dominiq@lps.ens.fr> wrote:
>> Please keep an eye out for people reporting problems.
> It caused pr71047.
>
>> I'll commit the patch to the 6-branch next weekend as I am traveling
>> for the next week.
> Could you please wait for a fix?
>
> TIA
>
> Dominique
>
See https://gcc.gnu.org/ml/fortran/2016-05/msg00032.html for the fix.
---
Fritz Reese
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-05-13 0:15 ` Fritz Reese
@ 2016-05-14 20:01 ` Steve Kargl
0 siblings, 0 replies; 16+ messages in thread
From: Steve Kargl @ 2016-05-14 20:01 UTC (permalink / raw)
To: Fritz Reese; +Cc: Dominique d'Humières, fortran
On Thu, May 12, 2016 at 08:15:26PM -0400, Fritz Reese wrote:
> On Tue, May 10, 2016 at 6:34 PM, Dominique d'Humières
> <dominiq@lps.ens.fr> wrote:
> >> Please keep an eye out for people reporting problems.
> > It caused pr71047.
> >
> >> I'll commit the patch to the 6-branch next weekend as I am traveling
> >> for the next week.
> > Could you please wait for a fix?
> >
> > TIA
> >
> > Dominique
> >
>
> See https://gcc.gnu.org/ml/fortran/2016-05/msg00032.html for the fix.
>
Committed to trunk. Committed with a cumulative patch to 6-branch.
Thanks for the patch. Please keep an eye open for bug reports.
--
Steve
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-05-10 17:37 ` Jerry DeLisle
@ 2016-05-11 7:00 ` Paul Richard Thomas
0 siblings, 0 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2016-05-11 7:00 UTC (permalink / raw)
To: Jerry DeLisle; +Cc: Steve Kargl, Fritz Reese, fortran
Dear All,
With regard to being short of people to do reviews, I am on track to
come back into the fold early in July and should be able to contribute
as before.
I apologize to one and all for taking time out but dealing with 16
years worth of accumulated "stuff" is a more than full time job :-(
With best regards
Paul
On 10 May 2016 at 19:37, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 05/07/2016 04:21 PM, Steve Kargl wrote:
>> On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>>>
> --- snip ---
>
>> After bootstrapping and testing on x86_64-*-freebsd, I have committed
>> this to trunk as revision 235999.
>>
>> Please keep an eye out for people reporting problems.
>>
>> I'll commit the patch to the 6-branch next weekend as I am traveling
>> for the next week.
>>
>> Fritz (and colleagues) thanks for the patch and your patiences.
>>
>
> Thanks Steve for following this. I think we are a bit short of people right now
> to do the reviews.
>
> Jerry
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-05-07 23:22 ` Steve Kargl
@ 2016-05-10 17:37 ` Jerry DeLisle
2016-05-11 7:00 ` Paul Richard Thomas
0 siblings, 1 reply; 16+ messages in thread
From: Jerry DeLisle @ 2016-05-10 17:37 UTC (permalink / raw)
To: Steve Kargl, Fritz Reese; +Cc: fortran
On 05/07/2016 04:21 PM, Steve Kargl wrote:
> On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>>
--- snip ---
> After bootstrapping and testing on x86_64-*-freebsd, I have committed
> this to trunk as revision 235999.
>
> Please keep an eye out for people reporting problems.
>
> I'll commit the patch to the 6-branch next weekend as I am traveling
> for the next week.
>
> Fritz (and colleagues) thanks for the patch and your patiences.
>
Thanks Steve for following this. I think we are a bit short of people right now
to do the reviews.
Jerry
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-03-01 21:07 ` Fritz Reese
2016-03-02 0:25 ` Steve Kargl
2016-03-03 14:31 ` Jim MacArthur
@ 2016-05-07 23:22 ` Steve Kargl
2016-05-10 17:37 ` Jerry DeLisle
2 siblings, 1 reply; 16+ messages in thread
From: Steve Kargl @ 2016-05-07 23:22 UTC (permalink / raw)
To: Fritz Reese; +Cc: fortran
On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>
> Please see the previous thread on this discussion for my original proposal:
> https://gcc.gnu.org/ml/fortran/2014-09/msg00255.html
>
> It has been a year and a half since I originally opened this
> discussion. For a quick refresher: I had drafted patches to introduce
> some old compiler extensions to GNU Fortran, enabled by a special
> compile flag. I had these extensions fully functional in gcc-4.8.3,
> with a new testsuite and no regressions, but it was requested that I
> rebase my patches on the gcc trunk (gcc-5 at the time) before
> submitting them to GNU.
>
> The first six months went by awaiting legal confirmation of my
> copyright assignment, since my patches were nontrivial. After a
> succesful copyright agreement with the FSF the second six months went
> by attempting the rebase. With the fairly significant architectural
> changes from gcc-4.8 to gcc-5, this was more time-consuming than
> originally expected. Finally, the last six months I fell ill and was
> unable to perform any work whatsoever. Now I have fully recovered and
> have finished up rebasing my first patch on the gcc development trunk
> which introduces the STRUCTURE, UNION, and MAP constructs.
>
> This submission contains (4) patches. The first three are minor
> self-contained refactoring steps which simplify the implementation of
> the much larger fourth patch, which contains the actual implementation
> of STRUCTURE and friends. It seems I actually have to submit these
> patches separately, because currently they are being blocked by the
> spam filter when sent with this post.
>
> I attempted to ensure all my changes were well-documented. Details
> from the user perspective as well as some implementation details can
> be found in the updated gfortran info and man pages. These pages
> describe the supported syntax of STRUCTURE, UNION, MAP, and RECORD
> statements, and how STRUCTURE differs from TYPE. The use of these
> statements is enabled ONLY through a new command-line option
> '-fdec-structure'. NB: My 4.8.3 compiler has a slew of DEC extensions
> which are all enabled with compiler options beginning with '-fdec-'. I
> plan to submit future patches for some of these as well.
>
> More details of the implementation can be found in comments throughout
> the source code, but I will summarize here for convenience.
>
> STRUCTURE is implemented as a very simple version of TYPE, with a new
> flavor FL_STRUCT. The key differences are outlined in the gfortran
> info page. Instances of STRUCTUREs still have basic type BT_DERIVED,
> and are treated mostly the same as instances of TYPEs. Just like TYPE,
> a STRUCTURE definition is stored in the symbol table beginning with an
> upper-case letter to disambiguate it from other symbols, which are
> converted to lower-case during parsing. Unlike TYPE however, STRUCTURE
> does not imply a FL_PROCEDURE symbol with the same name in lower-case
> for a constructor. The translation to generic is handled by the same
> function as for TYPE (gfc_get_derived_type), though STRUCTURE is
> always treated as if the SEQUENCE attribute were specified.
>
> The big reason for introducing this extension is because STRUCTURE
> definitions can also contain UNION definitions. These are much like C
> unions, which is something difficult to achieve in standard Fortran.
> Syntactically, UNION contains MAP definitions: each MAP defines a
> sub-structure within the union that all occupy the same storage.
> UNIONs are always components of STRUCTUREs, and always have a list of
> MAP components. A UNION component has basic type BT_UNION and its
> derived symbol (ts.u.derived) has flavor FL_UNION. A FL_UNION symbol
> is similar to a FL_STRUCTURE symbol but can make special assumptions
> about its list of MAP components (via usym->components). MAP
> components are exactly the same as STRUCTURE instances. They have
> basic type BT_DERIVED and their derived symbol (ts.u.derived) has
> flavor FL_STRUCT. When a FL_UNION is translated its typenode is built
> (in gfc_get_union_type) by setting its type to UNION_TYPE. Its fields
> will always be of MAP type, which have flavor FL_STRUCT and are again
> translated just like derived types with the SEQUENCE attribute (via
> gfc_get_derived_type).
>
> Since MAP and UNION (and STRUCTURE in certain cases - see info
> page/test cases) define structures anonymously, these structures are
> saved in the symbol table with autogenerated names. UNIONs are named
> UU$N, MAPs are named MM$N, and anonymous STRUCTUREs are named SS$N,
> where N is an integer which increments upon the creation of each
> anonymous name (separately for each type). The leading two uppercase
> characters and '#39; ensure the names are invalid Fortran identifiers.
>
> The submission also includes a suite of test cases alongside the other
> gfortran.dg tests which help isolate regressions that I have
> experienced while maintaining these patches on gcc-4.8.3 for the last
> [almost] two years.
>
> Please let me know your comments and concerns. I understand the patch
> is quite large, but I hope it is acceptable. I do intend to provide
> support for any problems which might be related to this extension.
>
I applied the four patches on my system. I needed to rename
your testcases from *.for to *.f90 (where I removed the -ffree-form
from dg-options). I also needed to fix up gfortran.texi. The
diff seems to be munged. Please check that my fix-up is accurate.
After bootstrapping and testing on x86_64-*-freebsd, I have committed
this to trunk as revision 235999.
Please keep an eye out for people reporting problems.
I'll commit the patch to the 6-branch next weekend as I am traveling
for the next week.
Fritz (and colleagues) thanks for the patch and your patiences.
--
Steve
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-03-06 12:17 ` Paul Richard Thomas
@ 2016-03-08 8:49 ` Paul Richard Thomas
0 siblings, 0 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2016-03-08 8:49 UTC (permalink / raw)
To: Steve Kargl; +Cc: Fritz Reese, fortran
Dear Fritz,
The patch is very good and can be committed to 7.0.0, as soon as it is
open. In fact, you have tidied up one or two of the nastier looking
parts of existing code to good advantage.
Many thanks for doing this work.
Paul
On 6 March 2016 at 13:17, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Fritz,
>
> I have reconstituted your patch. It applies cleanly to trunk and
> bootstraps and regtests OK on FC21/x86_64. So far so good!
>
> I will start the review tomorrow evening, with a view to reporting
> back on Tuesday or Wednesday.
>
> With best regards
>
> Paul
>
>
>
> On 2 March 2016 at 07:52, Paul Richard Thomas
> <paul.richard.thomas@gmail.com> wrote:
>> Dear Fritz and Steve,
>>
>> I am pleased to hear that you have recovered from your period of ill
>> health - welcome back!
>>
>> Indeed, I agree with Steve that in stage 4 we should not commit these
>> patches. I will undertake to review them in the next few days and I
>> suggest, Fritz, that you keep the bit-rot at bay until 7.0.0 hits the
>> street. At least the bit-rot will or should be negligible in stage 4
>> :-)
>>
>> Many thanks for working on these DEC extensions. I suggest that during
>> the wait period you submit the other patches for review. As you get
>> each of them ready to be committed to 7.0.0, I think that a final,
>> formal review would be in order.
>>
>> With best regards
>>
>> Paul
>>
>> On 2 March 2016 at 01:25, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>>> On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>>>>
>>>> The first six months went by awaiting legal confirmation of my
>>>> copyright assignment, since my patches were nontrivial. After a
>>>> succesful copyright agreement with the FSF the second six months went
>>>> by attempting the rebase. With the fairly significant architectural
>>>> changes from gcc-4.8 to gcc-5, this was more time-consuming than
>>>> originally expected. Finally, the last six months I fell ill and was
>>>> unable to perform any work whatsoever. Now I have fully recovered and
>>>> have finished up rebasing my first patch on the gcc development trunk
>>>> which introduces the STRUCTURE, UNION, and MAP constructs.
>>>
>>> Fritz,
>>>
>>> Thanks for working on this and the follow-up. Sorry to
>>> hear about your spell of ill health. gcc trunk is in
>>> stage 4 development, which is a regression fixes only
>>> stage in preparation for the gcc 6.1 release. If history
>>> holds, 6.1 will be out in a month or two. After 6.1 is
>>> out, we can work on integrating your patches.
>>>
>>> --
>>> Steve
>>
>>
>>
>> --
>> The difference between genius and stupidity is; genius has its limits.
>>
>> Albert Einstein
>
>
>
> --
> The difference between genius and stupidity is; genius has its limits.
>
> Albert Einstein
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-03-02 6:52 ` Paul Richard Thomas
@ 2016-03-06 12:17 ` Paul Richard Thomas
2016-03-08 8:49 ` Paul Richard Thomas
0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2016-03-06 12:17 UTC (permalink / raw)
To: Steve Kargl; +Cc: Fritz Reese, fortran
Dear Fritz,
I have reconstituted your patch. It applies cleanly to trunk and
bootstraps and regtests OK on FC21/x86_64. So far so good!
I will start the review tomorrow evening, with a view to reporting
back on Tuesday or Wednesday.
With best regards
Paul
On 2 March 2016 at 07:52, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Fritz and Steve,
>
> I am pleased to hear that you have recovered from your period of ill
> health - welcome back!
>
> Indeed, I agree with Steve that in stage 4 we should not commit these
> patches. I will undertake to review them in the next few days and I
> suggest, Fritz, that you keep the bit-rot at bay until 7.0.0 hits the
> street. At least the bit-rot will or should be negligible in stage 4
> :-)
>
> Many thanks for working on these DEC extensions. I suggest that during
> the wait period you submit the other patches for review. As you get
> each of them ready to be committed to 7.0.0, I think that a final,
> formal review would be in order.
>
> With best regards
>
> Paul
>
> On 2 March 2016 at 01:25, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>> On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>>>
>>> The first six months went by awaiting legal confirmation of my
>>> copyright assignment, since my patches were nontrivial. After a
>>> succesful copyright agreement with the FSF the second six months went
>>> by attempting the rebase. With the fairly significant architectural
>>> changes from gcc-4.8 to gcc-5, this was more time-consuming than
>>> originally expected. Finally, the last six months I fell ill and was
>>> unable to perform any work whatsoever. Now I have fully recovered and
>>> have finished up rebasing my first patch on the gcc development trunk
>>> which introduces the STRUCTURE, UNION, and MAP constructs.
>>
>> Fritz,
>>
>> Thanks for working on this and the follow-up. Sorry to
>> hear about your spell of ill health. gcc trunk is in
>> stage 4 development, which is a regression fixes only
>> stage in preparation for the gcc 6.1 release. If history
>> holds, 6.1 will be out in a month or two. After 6.1 is
>> out, we can work on integrating your patches.
>>
>> --
>> Steve
>
>
>
> --
> The difference between genius and stupidity is; genius has its limits.
>
> Albert Einstein
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-03-01 21:07 ` Fritz Reese
2016-03-02 0:25 ` Steve Kargl
@ 2016-03-03 14:31 ` Jim MacArthur
2016-05-07 23:22 ` Steve Kargl
2 siblings, 0 replies; 16+ messages in thread
From: Jim MacArthur @ 2016-03-03 14:31 UTC (permalink / raw)
To: fortran
On 01/03/16 21:07, Fritz Reese wrote:
> Greetings,
>
> Please see the previous thread on this discussion for my original proposal:
> https://gcc.gnu.org/ml/fortran/2014-09/msg00255.html
> STRUCTURE is implemented as a very simple version of TYPE, with a new
> flavor FL_STRUCT. The key differences are outlined in the gfortran
> info page. Instances of STRUCTUREs still have basic type BT_DERIVED,
> and are treated mostly the same as instances of TYPEs. Just like TYPE,
> a STRUCTURE definition is stored in the symbol table beginning with an
> upper-case letter to disambiguate it from other symbols, which are
> converted to lower-case during parsing. Unlike TYPE however, STRUCTURE
> does not imply a FL_PROCEDURE symbol with the same name in lower-case
> for a constructor. The translation to generic is handled by the same
> function as for TYPE (gfc_get_derived_type), though STRUCTURE is
> always treated as if the SEQUENCE attribute were specified.
I'm not qualified to review these, but I've tested them and they work
perfectly for everything I've thrown at them so far. The STRUCTURE
support is very welcome; I've had my own version of this for some time
but it didn't handle cases such as fields called 'eq', etc, as well as
this. Thank you very much for this work.
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-03-02 0:25 ` Steve Kargl
@ 2016-03-02 6:52 ` Paul Richard Thomas
2016-03-06 12:17 ` Paul Richard Thomas
0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2016-03-02 6:52 UTC (permalink / raw)
To: Steve Kargl; +Cc: Fritz Reese, fortran
Dear Fritz and Steve,
I am pleased to hear that you have recovered from your period of ill
health - welcome back!
Indeed, I agree with Steve that in stage 4 we should not commit these
patches. I will undertake to review them in the next few days and I
suggest, Fritz, that you keep the bit-rot at bay until 7.0.0 hits the
street. At least the bit-rot will or should be negligible in stage 4
:-)
Many thanks for working on these DEC extensions. I suggest that during
the wait period you submit the other patches for review. As you get
each of them ready to be committed to 7.0.0, I think that a final,
formal review would be in order.
With best regards
Paul
On 2 March 2016 at 01:25, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
> On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>>
>> The first six months went by awaiting legal confirmation of my
>> copyright assignment, since my patches were nontrivial. After a
>> succesful copyright agreement with the FSF the second six months went
>> by attempting the rebase. With the fairly significant architectural
>> changes from gcc-4.8 to gcc-5, this was more time-consuming than
>> originally expected. Finally, the last six months I fell ill and was
>> unable to perform any work whatsoever. Now I have fully recovered and
>> have finished up rebasing my first patch on the gcc development trunk
>> which introduces the STRUCTURE, UNION, and MAP constructs.
>
> Fritz,
>
> Thanks for working on this and the follow-up. Sorry to
> hear about your spell of ill health. gcc trunk is in
> stage 4 development, which is a regression fixes only
> stage in preparation for the gcc 6.1 release. If history
> holds, 6.1 will be out in a month or two. After 6.1 is
> out, we can work on integrating your patches.
>
> --
> Steve
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: Fwd: DEC Extension Patches: Structure, Union, and Map
2016-03-01 21:07 ` Fritz Reese
@ 2016-03-02 0:25 ` Steve Kargl
2016-03-02 6:52 ` Paul Richard Thomas
2016-03-03 14:31 ` Jim MacArthur
2016-05-07 23:22 ` Steve Kargl
2 siblings, 1 reply; 16+ messages in thread
From: Steve Kargl @ 2016-03-02 0:25 UTC (permalink / raw)
To: Fritz Reese; +Cc: fortran
On Tue, Mar 01, 2016 at 04:07:25PM -0500, Fritz Reese wrote:
>
> The first six months went by awaiting legal confirmation of my
> copyright assignment, since my patches were nontrivial. After a
> succesful copyright agreement with the FSF the second six months went
> by attempting the rebase. With the fairly significant architectural
> changes from gcc-4.8 to gcc-5, this was more time-consuming than
> originally expected. Finally, the last six months I fell ill and was
> unable to perform any work whatsoever. Now I have fully recovered and
> have finished up rebasing my first patch on the gcc development trunk
> which introduces the STRUCTURE, UNION, and MAP constructs.
Fritz,
Thanks for working on this and the follow-up. Sorry to
hear about your spell of ill health. gcc trunk is in
stage 4 development, which is a regression fixes only
stage in preparation for the gcc 6.1 release. If history
holds, 6.1 will be out in a month or two. After 6.1 is
out, we can work on integrating your patches.
--
Steve
^ permalink raw reply [flat|nested] 16+ messages in thread
* RE: Fwd: DEC Extension Patches: Structure, Union, and Map
@ 2016-03-01 21:25 Fritz Reese
0 siblings, 0 replies; 16+ messages in thread
From: Fritz Reese @ 2016-03-01 21:25 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 286 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 the big one, patch 4. It is compressed
with gzip since it is 150KB uncompressed.
---
Fritz Reese
[-- Attachment #2: 0004-2016-03-01-Fritz-Reese-fritzoreese-gmail.com.patch.gz --]
[-- Type: application/x-gzip, Size: 40164 bytes --]
^ permalink raw reply [flat|nested] 16+ messages in thread
* RE: Fwd: DEC Extension Patches: Structure, Union, and Map
@ 2016-03-01 21:18 Fritz Reese
0 siblings, 0 replies; 16+ messages in thread
From: Fritz Reese @ 2016-03-01 21:18 UTC (permalink / raw)
To: gcc-patches, fortran
[-- 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
^ permalink raw reply [flat|nested] 16+ messages in thread
* RE: Fwd: DEC Extension Patches: Structure, Union, and Map
@ 2016-03-01 21:17 Fritz Reese
0 siblings, 0 replies; 16+ messages in thread
From: Fritz Reese @ 2016-03-01 21:17 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 213 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 2:
---
Fritz Reese
[-- Attachment #2: 0002-2014-11-10-Fritz-Reese-fritzoreese-gmail.com.patch --]
[-- Type: text/x-patch, Size: 28922 bytes --]
From 2f7077c45fdcf2d05554d9d2e22fc5261bd95661 Mon Sep 17 00:00:00 2001
From: Fritz O. Reese <fritzoreese@gmail.com>
Date: Mon, 10 Nov 2014 13:34:06 -0500
Subject: [PATCH 2/4] 2014-11-10 Fritz Reese <fritzoreese@gmail.com>
gcc/fortran/
* resolve.c (resolve_component): New function.
(resolve_fl_derived0): Move component loop code to resolve_component.
---
gcc/fortran/resolve.c | 742 ++++++++++++++++++++++++-------------------------
1 files changed, 365 insertions(+), 377 deletions(-)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 556c846..1c3b814 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12899,438 +12899,426 @@ check_defined_assignments (gfc_symbol *derived)
}
-/* Resolve the components of a derived type. This does not have to wait until
- resolution stage, but can be done as soon as the dt declaration has been
- parsed. */
+/* Resolve a single component of a derived type. */
static bool
-resolve_fl_derived0 (gfc_symbol *sym)
+resolve_component (gfc_component *c, gfc_symbol *sym)
{
- gfc_symbol* super_type;
- gfc_component *c;
+ gfc_symbol *super_type;
- if (sym->attr.unlimited_polymorphic)
+ if (c->attr.artificial)
return true;
- super_type = gfc_get_derived_super_type (sym);
+ /* F2008, C442. */
+ if ((!sym->attr.is_class || c != sym->components)
+ && c->attr.codimension
+ && (!c->attr.allocatable || (c->as && c->as->type != AS_DEFERRED)))
+ {
+ gfc_error ("Coarray component %qs at %L must be allocatable with "
+ "deferred shape", c->name, &c->loc);
+ return false;
+ }
- /* F2008, C432. */
- if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
+ /* F2008, C443. */
+ if (c->attr.codimension && c->ts.type == BT_DERIVED
+ && c->ts.u.derived->ts.is_iso_c)
{
- gfc_error ("As extending type %qs at %L has a coarray component, "
- "parent type %qs shall also have one", sym->name,
- &sym->declared_at, super_type->name);
+ gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+ "shall not be a coarray", c->name, &c->loc);
return false;
}
- /* Ensure the extended type gets resolved before we do. */
- if (super_type && !resolve_fl_derived0 (super_type))
- return false;
+ /* F2008, C444. */
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
+ && (c->attr.codimension || c->attr.pointer || c->attr.dimension
+ || c->attr.allocatable))
+ {
+ gfc_error ("Component %qs at %L with coarray component "
+ "shall be a nonpointer, nonallocatable scalar",
+ c->name, &c->loc);
+ return false;
+ }
- /* An ABSTRACT type must be extensible. */
- if (sym->attr.abstract && !gfc_type_is_extensible (sym))
+ /* F2008, C448. */
+ if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer))
{
- gfc_error ("Non-extensible derived-type %qs at %L must not be ABSTRACT",
- sym->name, &sym->declared_at);
+ gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
+ "is not an array pointer", c->name, &c->loc);
return false;
}
- c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
- : sym->components;
+ if (c->attr.proc_pointer && c->ts.interface)
+ {
+ gfc_symbol *ifc = c->ts.interface;
- bool success = true;
+ if (!sym->attr.vtype
+ && !check_proc_interface (ifc, &c->loc))
+ return false;
- for ( ; c != NULL; c = c->next)
+ if (ifc->attr.if_source || ifc->attr.intrinsic)
+ {
+ /* Resolve interface and copy attributes. */
+ if (ifc->formal && !ifc->formal_ns)
+ resolve_symbol (ifc);
+ if (ifc->attr.intrinsic)
+ gfc_resolve_intrinsic (ifc, &ifc->declared_at);
+
+ if (ifc->result)
+ {
+ c->ts = ifc->result->ts;
+ c->attr.allocatable = ifc->result->attr.allocatable;
+ c->attr.pointer = ifc->result->attr.pointer;
+ c->attr.dimension = ifc->result->attr.dimension;
+ c->as = gfc_copy_array_spec (ifc->result->as);
+ c->attr.class_ok = ifc->result->attr.class_ok;
+ }
+ else
+ {
+ c->ts = ifc->ts;
+ c->attr.allocatable = ifc->attr.allocatable;
+ c->attr.pointer = ifc->attr.pointer;
+ c->attr.dimension = ifc->attr.dimension;
+ c->as = gfc_copy_array_spec (ifc->as);
+ c->attr.class_ok = ifc->attr.class_ok;
+ }
+ c->ts.interface = ifc;
+ c->attr.function = ifc->attr.function;
+ c->attr.subroutine = ifc->attr.subroutine;
+
+ c->attr.pure = ifc->attr.pure;
+ c->attr.elemental = ifc->attr.elemental;
+ c->attr.recursive = ifc->attr.recursive;
+ c->attr.always_explicit = ifc->attr.always_explicit;
+ c->attr.ext_attr |= ifc->attr.ext_attr;
+ /* Copy char length. */
+ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
+ {
+ gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
+ if (cl->length && !cl->resolved
+ && !gfc_resolve_expr (cl->length))
+ return false;
+ c->ts.u.cl = cl;
+ }
+ }
+ }
+ else if (c->attr.proc_pointer && c->ts.type == BT_UNKNOWN)
{
- if (c->attr.artificial)
- continue;
+ /* Since PPCs are not implicitly typed, a PPC without an explicit
+ interface must be a subroutine. */
+ gfc_add_subroutine (&c->attr, c->name, &c->loc);
+ }
- /* F2008, C442. */
- if ((!sym->attr.is_class || c != sym->components)
- && c->attr.codimension
- && (!c->attr.allocatable || (c->as && c->as->type != AS_DEFERRED)))
- {
- gfc_error ("Coarray component %qs at %L must be allocatable with "
- "deferred shape", c->name, &c->loc);
- success = false;
- continue;
- }
+ /* Procedure pointer components: Check PASS arg. */
+ if (c->attr.proc_pointer && !c->tb->nopass && c->tb->pass_arg_num == 0
+ && !sym->attr.vtype)
+ {
+ gfc_symbol* me_arg;
- /* F2008, C443. */
- if (c->attr.codimension && c->ts.type == BT_DERIVED
- && c->ts.u.derived->ts.is_iso_c)
- {
- gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
- "shall not be a coarray", c->name, &c->loc);
- success = false;
- continue;
- }
+ if (c->tb->pass_arg)
+ {
+ gfc_formal_arglist* i;
- /* F2008, C444. */
- if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
- && (c->attr.codimension || c->attr.pointer || c->attr.dimension
- || c->attr.allocatable))
- {
- gfc_error ("Component %qs at %L with coarray component "
- "shall be a nonpointer, nonallocatable scalar",
- c->name, &c->loc);
- success = false;
- continue;
- }
+ /* If an explicit passing argument name is given, walk the arg-list
+ and look for it. */
- /* F2008, C448. */
- if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer))
- {
- gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
- "is not an array pointer", c->name, &c->loc);
- success = false;
- continue;
- }
+ me_arg = NULL;
+ c->tb->pass_arg_num = 1;
+ for (i = c->ts.interface->formal; i; i = i->next)
+ {
+ if (!strcmp (i->sym->name, c->tb->pass_arg))
+ {
+ me_arg = i->sym;
+ break;
+ }
+ c->tb->pass_arg_num++;
+ }
- if (c->attr.proc_pointer && c->ts.interface)
- {
- gfc_symbol *ifc = c->ts.interface;
+ if (!me_arg)
+ {
+ gfc_error ("Procedure pointer component %qs with PASS(%s) "
+ "at %L has no argument %qs", c->name,
+ c->tb->pass_arg, &c->loc, c->tb->pass_arg);
+ c->tb->error = 1;
+ return false;
+ }
+ }
+ else
+ {
+ /* Otherwise, take the first one; there should in fact be at least
+ one. */
+ c->tb->pass_arg_num = 1;
+ if (!c->ts.interface->formal)
+ {
+ gfc_error ("Procedure pointer component %qs with PASS at %L "
+ "must have at least one argument",
+ c->name, &c->loc);
+ c->tb->error = 1;
+ return false;
+ }
+ me_arg = c->ts.interface->formal->sym;
+ }
- if (!sym->attr.vtype && !check_proc_interface (ifc, &c->loc))
- {
- c->tb->error = 1;
- success = false;
- continue;
- }
+ /* Now check that the argument-type matches. */
+ gcc_assert (me_arg);
+ if ((me_arg->ts.type != BT_DERIVED && me_arg->ts.type != BT_CLASS)
+ || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
+ || (me_arg->ts.type == BT_CLASS
+ && CLASS_DATA (me_arg)->ts.u.derived != sym))
+ {
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
+ " the derived type %qs", me_arg->name, c->name,
+ me_arg->name, &c->loc, sym->name);
+ c->tb->error = 1;
+ return false;
+ }
- if (ifc->attr.if_source || ifc->attr.intrinsic)
- {
- /* Resolve interface and copy attributes. */
- if (ifc->formal && !ifc->formal_ns)
- resolve_symbol (ifc);
- if (ifc->attr.intrinsic)
- gfc_resolve_intrinsic (ifc, &ifc->declared_at);
+ /* Check for C453. */
+ if (me_arg->attr.dimension)
+ {
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
+ "must be scalar", me_arg->name, c->name, me_arg->name,
+ &c->loc);
+ c->tb->error = 1;
+ return false;
+ }
- if (ifc->result)
- {
- c->ts = ifc->result->ts;
- c->attr.allocatable = ifc->result->attr.allocatable;
- c->attr.pointer = ifc->result->attr.pointer;
- c->attr.dimension = ifc->result->attr.dimension;
- c->as = gfc_copy_array_spec (ifc->result->as);
- c->attr.class_ok = ifc->result->attr.class_ok;
- }
- else
- {
- c->ts = ifc->ts;
- c->attr.allocatable = ifc->attr.allocatable;
- c->attr.pointer = ifc->attr.pointer;
- c->attr.dimension = ifc->attr.dimension;
- c->as = gfc_copy_array_spec (ifc->as);
- c->attr.class_ok = ifc->attr.class_ok;
- }
- c->ts.interface = ifc;
- c->attr.function = ifc->attr.function;
- c->attr.subroutine = ifc->attr.subroutine;
-
- c->attr.pure = ifc->attr.pure;
- c->attr.elemental = ifc->attr.elemental;
- c->attr.recursive = ifc->attr.recursive;
- c->attr.always_explicit = ifc->attr.always_explicit;
- c->attr.ext_attr |= ifc->attr.ext_attr;
- /* Copy char length. */
- if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
- {
- gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
- if (cl->length && !cl->resolved
- && !gfc_resolve_expr (cl->length))
- {
- c->tb->error = 1;
- success = false;
- continue;
- }
- c->ts.u.cl = cl;
- }
- }
- }
- else if (c->attr.proc_pointer && c->ts.type == BT_UNKNOWN)
- {
- /* Since PPCs are not implicitly typed, a PPC without an explicit
- interface must be a subroutine. */
- gfc_add_subroutine (&c->attr, c->name, &c->loc);
- }
+ if (me_arg->attr.pointer)
+ {
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
+ "may not have the POINTER attribute", me_arg->name,
+ c->name, me_arg->name, &c->loc);
+ c->tb->error = 1;
+ return false;
+ }
- /* Procedure pointer components: Check PASS arg. */
- if (c->attr.proc_pointer && !c->tb->nopass && c->tb->pass_arg_num == 0
- && !sym->attr.vtype)
- {
- gfc_symbol* me_arg;
+ if (me_arg->attr.allocatable)
+ {
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
+ "may not be ALLOCATABLE", me_arg->name, c->name,
+ me_arg->name, &c->loc);
+ c->tb->error = 1;
+ return false;
+ }
- if (c->tb->pass_arg)
- {
- gfc_formal_arglist* i;
+ if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
+ gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
+ " at %L", c->name, &c->loc);
- /* If an explicit passing argument name is given, walk the arg-list
- and look for it. */
+ }
- me_arg = NULL;
- c->tb->pass_arg_num = 1;
- for (i = c->ts.interface->formal; i; i = i->next)
- {
- if (!strcmp (i->sym->name, c->tb->pass_arg))
- {
- me_arg = i->sym;
- break;
- }
- c->tb->pass_arg_num++;
- }
+ /* Check type-spec if this is not the parent-type component. */
+ if (((sym->attr.is_class
+ && (!sym->components->ts.u.derived->attr.extension
+ || c != sym->components->ts.u.derived->components))
+ || (!sym->attr.is_class
+ && (!sym->attr.extension || c != sym->components)))
+ && !sym->attr.vtype
+ && !resolve_typespec_used (&c->ts, &c->loc, c->name))
+ return false;
- if (!me_arg)
- {
- gfc_error ("Procedure pointer component %qs with PASS(%s) "
- "at %L has no argument %qs", c->name,
- c->tb->pass_arg, &c->loc, c->tb->pass_arg);
- c->tb->error = 1;
- success = false;
- continue;
- }
- }
- else
- {
- /* Otherwise, take the first one; there should in fact be at least
- one. */
- c->tb->pass_arg_num = 1;
- if (!c->ts.interface->formal)
- {
- gfc_error ("Procedure pointer component %qs with PASS at %L "
- "must have at least one argument",
- c->name, &c->loc);
- c->tb->error = 1;
- success = false;
- continue;
- }
- me_arg = c->ts.interface->formal->sym;
- }
+ super_type = gfc_get_derived_super_type (sym);
- /* Now check that the argument-type matches. */
- gcc_assert (me_arg);
- if ((me_arg->ts.type != BT_DERIVED && me_arg->ts.type != BT_CLASS)
- || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
- || (me_arg->ts.type == BT_CLASS
- && CLASS_DATA (me_arg)->ts.u.derived != sym))
- {
- gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
- " the derived type %qs", me_arg->name, c->name,
- me_arg->name, &c->loc, sym->name);
- c->tb->error = 1;
- success = false;
- continue;
- }
+ /* If this type is an extension, set the accessibility of the parent
+ component. */
+ if (super_type
+ && ((sym->attr.is_class
+ && c == sym->components->ts.u.derived->components)
+ || (!sym->attr.is_class && c == sym->components))
+ && strcmp (super_type->name, c->name) == 0)
+ c->attr.access = super_type->attr.access;
+
+ /* If this type is an extension, see if this component has the same name
+ as an inherited type-bound procedure. */
+ if (super_type && !sym->attr.is_class
+ && gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
+ {
+ gfc_error ("Component %qs of %qs at %L has the same name as an"
+ " inherited type-bound procedure",
+ c->name, sym->name, &c->loc);
+ return false;
+ }
- /* Check for C453. */
- if (me_arg->attr.dimension)
- {
- gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
- "must be scalar", me_arg->name, c->name, me_arg->name,
- &c->loc);
- c->tb->error = 1;
- success = false;
- continue;
- }
+ if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
+ && !c->ts.deferred)
+ {
+ if (c->ts.u.cl->length == NULL
+ || (!resolve_charlen(c->ts.u.cl))
+ || !gfc_is_constant_expr (c->ts.u.cl->length))
+ {
+ gfc_error ("Character length of component %qs needs to "
+ "be a constant specification expression at %L",
+ c->name,
+ c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);
+ return false;
+ }
+ }
- if (me_arg->attr.pointer)
- {
- gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
- "may not have the POINTER attribute", me_arg->name,
- c->name, me_arg->name, &c->loc);
- c->tb->error = 1;
- success = false;
- continue;
- }
+ if (c->ts.type == BT_CHARACTER && c->ts.deferred
+ && !c->attr.pointer && !c->attr.allocatable)
+ {
+ gfc_error ("Character component %qs of %qs at %L with deferred "
+ "length must be a POINTER or ALLOCATABLE",
+ c->name, sym->name, &c->loc);
+ return false;
+ }
- if (me_arg->attr.allocatable)
- {
- gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
- "may not be ALLOCATABLE", me_arg->name, c->name,
- me_arg->name, &c->loc);
- c->tb->error = 1;
- success = false;
- continue;
- }
+ /* Add the hidden deferred length field. */
+ if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function
+ && !sym->attr.is_class)
+ {
+ char name[GFC_MAX_SYMBOL_LEN+9];
+ gfc_component *strlen;
+ sprintf (name, "_%s_length", c->name);
+ strlen = gfc_find_component (sym, name, true, true);
+ if (strlen == NULL)
+ {
+ if (!gfc_add_component (sym, name, &strlen))
+ return false;
+ strlen->ts.type = BT_INTEGER;
+ strlen->ts.kind = gfc_charlen_int_kind;
+ strlen->attr.access = ACCESS_PRIVATE;
+ strlen->attr.artificial = 1;
+ }
+ }
- if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
- {
- gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
- " at %L", c->name, &c->loc);
- success = false;
- continue;
- }
+ if (c->ts.type == BT_DERIVED
+ && sym->component_access != ACCESS_PRIVATE
+ && gfc_check_symbol_access (sym)
+ && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
+ && !c->ts.u.derived->attr.use_assoc
+ && !gfc_check_symbol_access (c->ts.u.derived)
+ && !gfc_notify_std (GFC_STD_F2003, "the component %qs is a "
+ "PRIVATE type and cannot be a component of "
+ "%qs, which is PUBLIC at %L", c->name,
+ sym->name, &sym->declared_at))
+ return false;
- }
+ if ((sym->attr.sequence || sym->attr.is_bind_c) && c->ts.type == BT_CLASS)
+ {
+ gfc_error ("Polymorphic component %s at %L in SEQUENCE or BIND(C) "
+ "type %s", c->name, &c->loc, sym->name);
+ return false;
+ }
- /* Check type-spec if this is not the parent-type component. */
- if (((sym->attr.is_class
- && (!sym->components->ts.u.derived->attr.extension
- || c != sym->components->ts.u.derived->components))
- || (!sym->attr.is_class
- && (!sym->attr.extension || c != sym->components)))
- && !sym->attr.vtype
- && !resolve_typespec_used (&c->ts, &c->loc, c->name))
- return false;
+ if (sym->attr.sequence)
+ {
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.sequence == 0)
+ {
+ gfc_error ("Component %s of SEQUENCE type declared at %L does "
+ "not have the SEQUENCE attribute",
+ c->ts.u.derived->name, &sym->declared_at);
+ return false;
+ }
+ }
- /* If this type is an extension, set the accessibility of the parent
- component. */
- if (super_type
- && ((sym->attr.is_class
- && c == sym->components->ts.u.derived->components)
- || (!sym->attr.is_class && c == sym->components))
- && strcmp (super_type->name, c->name) == 0)
- c->attr.access = super_type->attr.access;
-
- /* If this type is an extension, see if this component has the same name
- as an inherited type-bound procedure. */
- if (super_type && !sym->attr.is_class
- && gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
- {
- gfc_error ("Component %qs of %qs at %L has the same name as an"
- " inherited type-bound procedure",
- c->name, sym->name, &c->loc);
- return false;
- }
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.generic)
+ c->ts.u.derived = gfc_find_dt_in_generic (c->ts.u.derived);
+ else if (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->ts.u.derived->attr.generic)
+ CLASS_DATA (c)->ts.u.derived
+ = gfc_find_dt_in_generic (CLASS_DATA (c)->ts.u.derived);
- if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
- && !c->ts.deferred)
- {
- if (c->ts.u.cl->length == NULL
- || (!resolve_charlen(c->ts.u.cl))
- || !gfc_is_constant_expr (c->ts.u.cl->length))
- {
- gfc_error ("Character length of component %qs needs to "
- "be a constant specification expression at %L",
- c->name,
- c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);
- return false;
- }
- }
+ if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
+ && c->attr.pointer && c->ts.u.derived->components == NULL
+ && !c->ts.u.derived->attr.zero_comp)
+ {
+ gfc_error ("The pointer component %qs of %qs at %L is a type "
+ "that has not been declared", c->name, sym->name,
+ &c->loc);
+ return false;
+ }
- if (c->ts.type == BT_CHARACTER && c->ts.deferred
- && !c->attr.pointer && !c->attr.allocatable)
- {
- gfc_error ("Character component %qs of %qs at %L with deferred "
- "length must be a POINTER or ALLOCATABLE",
- c->name, sym->name, &c->loc);
- return false;
- }
+ if (c->ts.type == BT_CLASS && c->attr.class_ok
+ && CLASS_DATA (c)->attr.class_pointer
+ && CLASS_DATA (c)->ts.u.derived->components == NULL
+ && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp
+ && !UNLIMITED_POLY (c))
+ {
+ gfc_error ("The pointer component %qs of %qs at %L is a type "
+ "that has not been declared", c->name, sym->name,
+ &c->loc);
+ return false;
+ }
- /* Add the hidden deferred length field. */
- if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function
- && !sym->attr.is_class)
- {
- char name[GFC_MAX_SYMBOL_LEN+9];
- gfc_component *strlen;
- sprintf (name, "_%s_length", c->name);
- strlen = gfc_find_component (sym, name, true, true);
- if (strlen == NULL)
- {
- if (!gfc_add_component (sym, name, &strlen))
- return false;
- strlen->ts.type = BT_INTEGER;
- strlen->ts.kind = gfc_charlen_int_kind;
- strlen->attr.access = ACCESS_PRIVATE;
- strlen->attr.artificial = 1;
- }
- }
+ /* C437. */
+ if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
+ && (!c->attr.class_ok
+ || !(CLASS_DATA (c)->attr.class_pointer
+ || CLASS_DATA (c)->attr.allocatable)))
+ {
+ gfc_error ("Component %qs with CLASS at %L must be allocatable "
+ "or pointer", c->name, &c->loc);
+ /* Prevent a recurrence of the error. */
+ c->ts.type = BT_UNKNOWN;
+ return false;
+ }
- if (c->ts.type == BT_DERIVED
- && sym->component_access != ACCESS_PRIVATE
- && gfc_check_symbol_access (sym)
- && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
- && !c->ts.u.derived->attr.use_assoc
- && !gfc_check_symbol_access (c->ts.u.derived)
- && !gfc_notify_std (GFC_STD_F2003, "the component %qs is a "
- "PRIVATE type and cannot be a component of "
- "%qs, which is PUBLIC at %L", c->name,
- sym->name, &sym->declared_at))
- return false;
+ /* Ensure that all the derived type components are put on the
+ derived type list; even in formal namespaces, where derived type
+ pointer components might not have been declared. */
+ if (c->ts.type == BT_DERIVED
+ && c->ts.u.derived
+ && c->ts.u.derived->components
+ && c->attr.pointer
+ && sym != c->ts.u.derived)
+ add_dt_to_dt_list (c->ts.u.derived);
- if ((sym->attr.sequence || sym->attr.is_bind_c) && c->ts.type == BT_CLASS)
- {
- gfc_error ("Polymorphic component %s at %L in SEQUENCE or BIND(C) "
- "type %s", c->name, &c->loc, sym->name);
- return false;
- }
+ if (!gfc_resolve_array_spec (c->as,
+ !(c->attr.pointer || c->attr.proc_pointer
+ || c->attr.allocatable)))
+ return false;
- if (sym->attr.sequence)
- {
- if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.sequence == 0)
- {
- gfc_error ("Component %s of SEQUENCE type declared at %L does "
- "not have the SEQUENCE attribute",
- c->ts.u.derived->name, &sym->declared_at);
- return false;
- }
- }
+ if (c->initializer && !sym->attr.vtype
+ && !gfc_check_assign_symbol (sym, c, c->initializer))
+ return false;
- if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.generic)
- c->ts.u.derived = gfc_find_dt_in_generic (c->ts.u.derived);
- else if (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->ts.u.derived->attr.generic)
- CLASS_DATA (c)->ts.u.derived
- = gfc_find_dt_in_generic (CLASS_DATA (c)->ts.u.derived);
+ return true;
+}
- if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
- && c->attr.pointer && c->ts.u.derived->components == NULL
- && !c->ts.u.derived->attr.zero_comp)
- {
- gfc_error ("The pointer component %qs of %qs at %L is a type "
- "that has not been declared", c->name, sym->name,
- &c->loc);
- return false;
- }
- if (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->attr.class_pointer
- && CLASS_DATA (c)->ts.u.derived->components == NULL
- && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp
- && !UNLIMITED_POLY (c))
- {
- gfc_error ("The pointer component %qs of %qs at %L is a type "
- "that has not been declared", c->name, sym->name,
- &c->loc);
- return false;
- }
+/* Resolve the components of a derived type. This does not have to wait until
+ resolution stage, but can be done as soon as the dt declaration has been
+ parsed. */
- /* C437. */
- if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
- && (!c->attr.class_ok
- || !(CLASS_DATA (c)->attr.class_pointer
- || CLASS_DATA (c)->attr.allocatable)))
- {
- gfc_error ("Component %qs with CLASS at %L must be allocatable "
- "or pointer", c->name, &c->loc);
- /* Prevent a recurrence of the error. */
- c->ts.type = BT_UNKNOWN;
- return false;
- }
+static bool
+resolve_fl_derived0 (gfc_symbol *sym)
+{
+ gfc_symbol* super_type;
+ gfc_component *c;
- /* Ensure that all the derived type components are put on the
- derived type list; even in formal namespaces, where derived type
- pointer components might not have been declared. */
- if (c->ts.type == BT_DERIVED
- && c->ts.u.derived
- && c->ts.u.derived->components
- && c->attr.pointer
- && sym != c->ts.u.derived)
- add_dt_to_dt_list (c->ts.u.derived);
-
- if (!gfc_resolve_array_spec (c->as,
- !(c->attr.pointer || c->attr.proc_pointer
- || c->attr.allocatable)))
- return false;
+ if (sym->attr.unlimited_polymorphic)
+ return true;
- if (c->initializer && !sym->attr.vtype
- && !gfc_check_assign_symbol (sym, c, c->initializer))
- return false;
+ super_type = gfc_get_derived_super_type (sym);
+
+ /* F2008, C432. */
+ if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
+ {
+ gfc_error ("As extending type %qs at %L has a coarray component, "
+ "parent type %qs shall also have one", sym->name,
+ &sym->declared_at, super_type->name);
+ return false;
}
- if (!success)
+ /* Ensure the extended type gets resolved before we do. */
+ if (super_type && !resolve_fl_derived0 (super_type))
return false;
+ /* An ABSTRACT type must be extensible. */
+ if (sym->attr.abstract && !gfc_type_is_extensible (sym))
+ {
+ gfc_error ("Non-extensible derived-type %qs at %L must not be ABSTRACT",
+ sym->name, &sym->declared_at);
+ return false;
+ }
+
+ c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
+ : sym->components;
+
+ for ( ; c != NULL; c = c->next)
+ if (!resolve_component (c, sym))
+ return false;
+
check_defined_assignments (sym);
if (!sym->attr.defined_assign_comp && super_type)
--
1.7.1
^ permalink raw reply [flat|nested] 16+ messages in thread
* RE: Fwd: DEC Extension Patches: Structure, Union, and Map
@ 2016-03-01 21:12 Fritz Reese
0 siblings, 0 replies; 16+ messages in thread
From: Fritz Reese @ 2016-03-01 21:12 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 210 bytes --]
Please see the original message:
https://gcc.gnu.org/ml/fortran/2016-03/msg00002.html
I have to send the patches separately, as together they are blocked by
the spam filter. This is part 1:
---
Fritz Reese
[-- Attachment #2: 0001-2014-10-16-Fritz-Reese-fritzoreese-gmail.com.patch --]
[-- Type: text/x-patch, Size: 8521 bytes --]
From 00eaf54e4cc4bb63bfbcb1ffab97cb9b593f2c6d Mon Sep 17 00:00:00 2001
From: Fritz O. Reese <fritzoreese@gmail.com>
Date: Thu, 16 Oct 2014 15:35:54 -0400
Subject: [PATCH 1/4] 2014-10-16 Fritz Reese <fritzoreese@gmail.com>
* gcc/fortran/module.c (dt_upper_string): Rename to gfc_dt_upper_string
(dt_lower_string): Likewise.
* gcc/fortran/gfortran.h: Make new gfc_dt_upper/lower_string global.
* gcc/fortran/class.c: Use gfc_dt_upper_string.
* gcc/fortran/decl.c: Likewise.
* gcc/fortran/symbol.c: Likewise.
---
gcc/fortran/class.c | 3 +--
gcc/fortran/decl.c | 12 +++---------
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.c | 26 +++++++++++++-------------
gcc/fortran/symbol.c | 11 +++--------
5 files changed, 22 insertions(+), 32 deletions(-)
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 6a7339f..b3e1b45 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -477,8 +477,7 @@ get_unique_type_string (char *string, gfc_symbol *derived)
if (derived->attr.unlimited_polymorphic)
strcpy (dt_name, "STAR");
else
- strcpy (dt_name, derived->name);
- dt_name[0] = TOUPPER (dt_name[0]);
+ strcpy (dt_name, gfc_dt_upper_string (derived->name));
if (derived->attr.unlimited_polymorphic)
sprintf (string, "_%s", dt_name);
else if (derived->module)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d3ddda2..2b92623 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2964,9 +2964,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
stored in a symtree with the first letter of the name capitalized; the
symtree with the all lower-case name contains the associated
generic function. */
- dt_name = gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) name[0]),
- (const char*)&name[1]);
+ dt_name = gfc_dt_upper_string (name);
sym = NULL;
dt_sym = NULL;
if (ts->kind != -1)
@@ -3480,9 +3478,7 @@ gfc_match_import (void)
letter of the name capitalized; the symtree with the all
lower-case name contains the associated generic function. */
st = gfc_new_symtree (&gfc_current_ns->sym_root,
- gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) name[0]),
- &name[1]));
+ gfc_dt_upper_string (name));
st->n.sym = sym;
sym->refs++;
sym->attr.imported = 1;
@@ -8099,9 +8095,7 @@ gfc_match_derived_decl (void)
if (!sym)
{
/* Use upper case to save the actual derived-type symbol. */
- gfc_get_symbol (gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) gensym->name[0]),
- &gensym->name[1]), NULL, &sym);
+ gfc_get_symbol (gfc_dt_upper_string (gensym->name), NULL, &sym);
sym->name = gfc_get_string (gensym->name);
head = gensym->generic;
intr = gfc_get_interface ();
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 33fffd8..2e6ea4b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3174,6 +3174,8 @@ void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_symbol_access (gfc_symbol *);
void gfc_free_use_stmts (gfc_use_list *);
+const char *gfc_dt_lower_string (const char *);
+const char *gfc_dt_upper_string (const char *);
/* primary.c */
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 32ee526..152574c 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -422,8 +422,8 @@ resolve_fixups (fixup_t *f, void *gp)
to convert the symtree name of a derived-type to the symbol name or to
the name of the associated generic function. */
-static const char *
-dt_lower_string (const char *name)
+const char *
+gfc_dt_lower_string (const char *name)
{
if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
return gfc_get_string ("%c%s", (char) TOLOWER ((unsigned char) name[0]),
@@ -437,8 +437,8 @@ dt_lower_string (const char *name)
symtree/symbol name of the associated generic function start with a lower-
case character. */
-static const char *
-dt_upper_string (const char *name)
+const char *
+gfc_dt_upper_string (const char *name)
{
if (name[0] != (char) TOUPPER ((unsigned char) name[0]))
return gfc_get_string ("%c%s", (char) TOUPPER ((unsigned char) name[0]),
@@ -832,7 +832,7 @@ find_use_name_n (const char *name, int *inst, bool interface)
/* For derived types. */
if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
- low_name = dt_lower_string (name);
+ low_name = gfc_dt_lower_string (name);
i = 0;
for (u = gfc_rename_list; u; u = u->next)
@@ -861,7 +861,7 @@ find_use_name_n (const char *name, int *inst, bool interface)
{
if (u->local_name[0] == '\0')
return name;
- return dt_upper_string (u->local_name);
+ return gfc_dt_upper_string (u->local_name);
}
return (u->local_name[0] != '\0') ? u->local_name : name;
@@ -990,7 +990,7 @@ add_true_name (gfc_symbol *sym)
t = XCNEW (true_name);
t->sym = sym;
if (sym->attr.flavor == FL_DERIVED)
- t->name = dt_upper_string (sym->name);
+ t->name = gfc_dt_upper_string (sym->name);
else
t->name = sym->name;
@@ -1012,7 +1012,7 @@ build_tnt (gfc_symtree *st)
build_tnt (st->right);
if (st->n.sym->attr.flavor == FL_DERIVED)
- name = dt_upper_string (st->n.sym->name);
+ name = gfc_dt_upper_string (st->n.sym->name);
else
name = st->n.sym->name;
@@ -3323,7 +3323,7 @@ fix_mio_expr (gfc_expr *e)
{
const char *name = e->symtree->n.sym->name;
if (e->symtree->n.sym->attr.flavor == FL_DERIVED)
- name = dt_upper_string (name);
+ name = gfc_dt_upper_string (name);
ns_st = gfc_find_symtree (gfc_current_ns->sym_root, name);
}
@@ -4845,7 +4845,7 @@ load_needed (pointer_info *p)
1, &ns->proc_name);
sym = gfc_new_symbol (p->u.rsym.true_name, ns);
- sym->name = dt_lower_string (p->u.rsym.true_name);
+ sym->name = gfc_dt_lower_string (p->u.rsym.true_name);
sym->module = gfc_get_string (p->u.rsym.module);
if (p->u.rsym.binding_label)
sym->binding_label = IDENTIFIER_POINTER (get_identifier
@@ -5213,7 +5213,7 @@ read_module (void)
{
info->u.rsym.sym = gfc_new_symbol (info->u.rsym.true_name,
gfc_current_ns);
- info->u.rsym.sym->name = dt_lower_string (info->u.rsym.true_name);
+ info->u.rsym.sym->name = gfc_dt_lower_string (info->u.rsym.true_name);
sym = info->u.rsym.sym;
sym->module = gfc_get_string (info->u.rsym.module);
@@ -5560,7 +5560,7 @@ write_symbol (int n, gfc_symbol *sym)
if (sym->attr.flavor == FL_DERIVED)
{
const char *name;
- name = dt_upper_string (sym->name);
+ name = gfc_dt_upper_string (sym->name);
mio_pool_string (&name);
}
else
@@ -6568,7 +6568,7 @@ create_derived_type (const char *name, const char *modname,
sym->attr.function = 1;
sym->attr.generic = 1;
- gfc_get_sym_tree (dt_upper_string (sym->name),
+ gfc_get_sym_tree (gfc_dt_upper_string (sym->name),
gfc_current_ns, &tmp_symtree, false);
dt_sym = tmp_symtree->n.sym;
dt_sym->name = gfc_get_string (sym->name);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 8efd12c..f6819a6 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3339,10 +3339,8 @@ gfc_restore_last_undo_checkpoint (void)
letter capitalized; the all lower-case version to the
derived type contains its associated generic function. */
if (p->attr.flavor == FL_DERIVED)
- gfc_delete_symtree (&p->ns->sym_root, gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) p->name[0]),
- &p->name[1]));
- else
+ gfc_delete_symtree (&p->ns->sym_root,gfc_dt_upper_string (p->name));
+ else
gfc_delete_symtree (&p->ns->sym_root, p->name);
gfc_release_symbol (p);
@@ -4526,10 +4524,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
const char *hidden_name;
gfc_interface *intr, *head;
- hidden_name = gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char)
- tmp_sym->name[0]),
- &tmp_sym->name[1]);
+ hidden_name = gfc_dt_upper_string (tmp_sym->name);
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
hidden_name);
gcc_assert (tmp_symtree == NULL);
--
1.7.1
^ permalink raw reply [flat|nested] 16+ messages in thread
* Fwd: DEC Extension Patches: Structure, Union, and Map
[not found] ` <CAE4aFAmvOxARXxx2Z=kPxnXGmAfdZed0HAt_D9UVEm6OrHX50w@mail.gmail.com>
@ 2016-03-01 21:07 ` Fritz Reese
2016-03-02 0:25 ` Steve Kargl
` (2 more replies)
0 siblings, 3 replies; 16+ messages in thread
From: Fritz Reese @ 2016-03-01 21:07 UTC (permalink / raw)
To: fortran
Greetings,
Please see the previous thread on this discussion for my original proposal:
https://gcc.gnu.org/ml/fortran/2014-09/msg00255.html
It has been a year and a half since I originally opened this
discussion. For a quick refresher: I had drafted patches to introduce
some old compiler extensions to GNU Fortran, enabled by a special
compile flag. I had these extensions fully functional in gcc-4.8.3,
with a new testsuite and no regressions, but it was requested that I
rebase my patches on the gcc trunk (gcc-5 at the time) before
submitting them to GNU.
The first six months went by awaiting legal confirmation of my
copyright assignment, since my patches were nontrivial. After a
succesful copyright agreement with the FSF the second six months went
by attempting the rebase. With the fairly significant architectural
changes from gcc-4.8 to gcc-5, this was more time-consuming than
originally expected. Finally, the last six months I fell ill and was
unable to perform any work whatsoever. Now I have fully recovered and
have finished up rebasing my first patch on the gcc development trunk
which introduces the STRUCTURE, UNION, and MAP constructs.
This submission contains (4) patches. The first three are minor
self-contained refactoring steps which simplify the implementation of
the much larger fourth patch, which contains the actual implementation
of STRUCTURE and friends. It seems I actually have to submit these
patches separately, because currently they are being blocked by the
spam filter when sent with this post.
I attempted to ensure all my changes were well-documented. Details
from the user perspective as well as some implementation details can
be found in the updated gfortran info and man pages. These pages
describe the supported syntax of STRUCTURE, UNION, MAP, and RECORD
statements, and how STRUCTURE differs from TYPE. The use of these
statements is enabled ONLY through a new command-line option
'-fdec-structure'. NB: My 4.8.3 compiler has a slew of DEC extensions
which are all enabled with compiler options beginning with '-fdec-'. I
plan to submit future patches for some of these as well.
More details of the implementation can be found in comments throughout
the source code, but I will summarize here for convenience.
STRUCTURE is implemented as a very simple version of TYPE, with a new
flavor FL_STRUCT. The key differences are outlined in the gfortran
info page. Instances of STRUCTUREs still have basic type BT_DERIVED,
and are treated mostly the same as instances of TYPEs. Just like TYPE,
a STRUCTURE definition is stored in the symbol table beginning with an
upper-case letter to disambiguate it from other symbols, which are
converted to lower-case during parsing. Unlike TYPE however, STRUCTURE
does not imply a FL_PROCEDURE symbol with the same name in lower-case
for a constructor. The translation to generic is handled by the same
function as for TYPE (gfc_get_derived_type), though STRUCTURE is
always treated as if the SEQUENCE attribute were specified.
The big reason for introducing this extension is because STRUCTURE
definitions can also contain UNION definitions. These are much like C
unions, which is something difficult to achieve in standard Fortran.
Syntactically, UNION contains MAP definitions: each MAP defines a
sub-structure within the union that all occupy the same storage.
UNIONs are always components of STRUCTUREs, and always have a list of
MAP components. A UNION component has basic type BT_UNION and its
derived symbol (ts.u.derived) has flavor FL_UNION. A FL_UNION symbol
is similar to a FL_STRUCTURE symbol but can make special assumptions
about its list of MAP components (via usym->components). MAP
components are exactly the same as STRUCTURE instances. They have
basic type BT_DERIVED and their derived symbol (ts.u.derived) has
flavor FL_STRUCT. When a FL_UNION is translated its typenode is built
(in gfc_get_union_type) by setting its type to UNION_TYPE. Its fields
will always be of MAP type, which have flavor FL_STRUCT and are again
translated just like derived types with the SEQUENCE attribute (via
gfc_get_derived_type).
Since MAP and UNION (and STRUCTURE in certain cases - see info
page/test cases) define structures anonymously, these structures are
saved in the symbol table with autogenerated names. UNIONs are named
UU$N, MAPs are named MM$N, and anonymous STRUCTUREs are named SS$N,
where N is an integer which increments upon the creation of each
anonymous name (separately for each type). The leading two uppercase
characters and '#39; ensure the names are invalid Fortran identifiers.
The submission also includes a suite of test cases alongside the other
gfortran.dg tests which help isolate regressions that I have
experienced while maintaining these patches on gcc-4.8.3 for the last
[almost] two years.
Please let me know your comments and concerns. I understand the patch
is quite large, but I hope it is acceptable. I do intend to provide
support for any problems which might be related to this extension.
- Fritz Reese
^ permalink raw reply [flat|nested] 16+ messages in thread
end of thread, other threads:[~2016-05-14 20:01 UTC | newest]
Thread overview: 16+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-05-10 22:34 Fwd: DEC Extension Patches: Structure, Union, and Map Dominique d'Humières
2016-05-13 0:15 ` Fritz Reese
2016-05-14 20:01 ` Steve Kargl
-- strict thread matches above, loose matches on Subject: below --
2016-03-01 21:25 Fritz Reese
2016-03-01 21:18 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
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).