* [Patch, fortran] Bug fixes, including regressions, for the associate construct
@ 2017-09-20 16:45 Paul Richard Thomas
2017-09-21 0:52 ` Jerry DeLisle
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2017-09-20 16:45 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2775 bytes --]
In the last update to the Parameterized Derived Types implementation,
I fixed PR60483 as a side effect. I then checked all the ASSOCIATE
bugs and noted that I was responsible for a number of regressions due
to a patch that I applied last year. I determined to fix them and
found that I couldn't stop.
The PRs in the ChangeLogs are the low(ish) lying fruit and the changes
are fairly obvious or are described in the ChangeLog or the comments.
Bootstrapped and regtested on FC23/x86_64 - OK for trunk and later on 7-branch?
Remaining, in increasing order, of difficulty are:
PR77296 and PR60458: The deferred string length is getting mangled by
the associate construct. A bit of work in trans-stmt.c is needed. Note
that the chunk in resolve.c(deferred_requirements) gets these PRs
through the front end.
PR68546: The non-contiguous selector needs packing and unpacking.
PR56386 - here, a contained function is used as the selector. It
cannot be resolved in primary.c because it forces the function symbol
to be marked as external. In consequence, the selector name does not
get a type. I have no idea, at present, how to fix this without
blowing subsequent parsing within the associate block out of the
water.
Cheers
Paul
2017-09-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/52832
* match.c (gfc_match_associate): Before failing the association
try again, allowing a proc pointer selector.
PR fortran/80120
PR fortran/81903
PR fortran/82121
* primary.c (gfc_match_varspec): Introduce 'tgt_expr', which
points to the associate selector, if any. Go through selector
references, after resolution for variables, to catch any full
or section array references. If a class associate name does
not have the same declared type as the selector, resolve the
selector and copy the declared type to the associate name.
Before throwing a no implicit type error, resolve all allowed
selector expressions, and copy the resulting typespec.
PR fortran/67543
* resolve.c (resolve_assoc_var): Selector must cannot be the
NULL expression and it must have a type.
PR fortran/78152
* resolve.c (resolve_symbol): Allow associate names to be
coarrays.
2017-09-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/78512
* gfortran.dg/associate_26.f90 : New test.
PR fortran/80120
* gfortran.dg/associate_27.f90 : New test.
PR fortran/81903
* gfortran.dg/associate_28.f90 : New test.
PR fortran/82121
* gfortran.dg/associate_29.f90 : New test.
PR fortran/67543
* gfortran.dg/associate_30.f90 : New test.
PR fortran/52832
* gfortran.dg/associate_31.f90 : New test.
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 13566 bytes --]
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 252893)
--- gcc/fortran/match.c (working copy)
*************** gfc_match_associate (void)
*** 1885,1892 ****
if (gfc_match (" %n => %e", newAssoc->name, &newAssoc->target)
!= MATCH_YES)
{
! gfc_error ("Expected association at %C");
! goto assocListError;
}
newAssoc->where = gfc_current_locus;
--- 1885,1899 ----
if (gfc_match (" %n => %e", newAssoc->name, &newAssoc->target)
!= MATCH_YES)
{
! /* Have another go, allowing for procedure pointer selectors. */
! gfc_matching_procptr_assignment = 1;
! if (gfc_match (" %n => %e", newAssoc->name, &newAssoc->target)
! != MATCH_YES)
! {
! gfc_error ("Expected association at %C");
! goto assocListError;
! }
! gfc_matching_procptr_assignment = 0;
}
newAssoc->where = gfc_current_locus;
Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c (revision 252894)
--- gcc/fortran/primary.c (working copy)
*************** gfc_match_varspec (gfc_expr *primary, in
*** 1937,1942 ****
--- 1937,1943 ----
gfc_ref *substring, *tail, *tmp;
gfc_component *component;
gfc_symbol *sym = primary->symtree->n.sym;
+ gfc_expr *tgt_expr = NULL;
match m;
bool unknown;
char sep;
*************** gfc_match_varspec (gfc_expr *primary, in
*** 1965,1970 ****
--- 1966,1974 ----
}
}
+ if (sym->assoc && sym->assoc->target)
+ tgt_expr = sym->assoc->target;
+
/* For associate names, we may not yet know whether they are arrays or not.
If the selector expression is unambiguously an array; eg. a full array
or an array section, then the associate name must be an array and we can
*************** gfc_match_varspec (gfc_expr *primary, in
*** 1976,2001 ****
&& sym->ts.type != BT_CLASS
&& !sym->attr.dimension)
{
! if ((!sym->assoc->dangling
! && sym->assoc->target
! && sym->assoc->target->ref
! && sym->assoc->target->ref->type == REF_ARRAY
! && (sym->assoc->target->ref->u.ar.type == AR_FULL
! || sym->assoc->target->ref->u.ar.type == AR_SECTION))
! ||
! (!(sym->assoc->dangling || sym->ts.type == BT_CHARACTER)
! && sym->assoc->st
! && sym->assoc->st->n.sym
! && sym->assoc->st->n.sym->attr.dimension == 0))
{
! sym->attr.dimension = 1;
! if (sym->as == NULL && sym->assoc
&& sym->assoc->st
&& sym->assoc->st->n.sym
&& sym->assoc->st->n.sym->as)
sym->as = gfc_copy_array_spec (sym->assoc->st->n.sym->as);
}
}
if ((equiv_flag && gfc_peek_ascii_char () == '(')
|| gfc_peek_ascii_char () == '[' || sym->attr.codimension
--- 1980,2022 ----
&& sym->ts.type != BT_CLASS
&& !sym->attr.dimension)
{
! gfc_ref *ref = NULL;
!
! if (!sym->assoc->dangling && tgt_expr)
! {
! if (tgt_expr->expr_type == EXPR_VARIABLE)
! gfc_resolve_expr (tgt_expr);
!
! ref = tgt_expr->ref;
! for (; ref; ref = ref->next)
! if (ref->type == REF_ARRAY
! && (ref->u.ar.type == AR_FULL
! || ref->u.ar.type == AR_SECTION))
! break;
! }
!
! if (ref || (!(sym->assoc->dangling || sym->ts.type == BT_CHARACTER)
! && sym->assoc->st
! && sym->assoc->st->n.sym
! && sym->assoc->st->n.sym->attr.dimension == 0))
{
! sym->attr.dimension = 1;
! if (sym->as == NULL
&& sym->assoc->st
&& sym->assoc->st->n.sym
&& sym->assoc->st->n.sym->as)
sym->as = gfc_copy_array_spec (sym->assoc->st->n.sym->as);
}
}
+ else if (sym->ts.type == BT_CLASS
+ && tgt_expr
+ && tgt_expr->expr_type == EXPR_VARIABLE
+ && sym->ts.u.derived != tgt_expr->ts.u.derived)
+ {
+ gfc_resolve_expr (tgt_expr);
+ if (tgt_expr->rank)
+ sym->ts.u.derived = tgt_expr->ts.u.derived;
+ }
if ((equiv_flag && gfc_peek_ascii_char () == '(')
|| gfc_peek_ascii_char () == '[' || sym->attr.codimension
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2055,2068 ****
&& gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns);
! /* Before throwing an error try resolving the target expression of
! associate names. This should resolve function calls, for example. */
if (sym->ts.type == BT_UNKNOWN && m == MATCH_YES)
{
! if (sym->assoc && sym->assoc->target)
{
! gfc_resolve_expr (sym->assoc->target);
! sym->ts = sym->assoc->target->ts;
}
if (sym->ts.type == BT_UNKNOWN)
--- 2076,2099 ----
&& gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns);
! /* See if there is a usable typespec in the "no IMPLICIT type" error. */
if (sym->ts.type == BT_UNKNOWN && m == MATCH_YES)
{
! bool permissible;
!
! /* These target expressions can ge resolved at any time. */
! permissible = tgt_expr && tgt_expr->symtree && tgt_expr->symtree->n.sym
! && (tgt_expr->symtree->n.sym->attr.use_assoc
! || tgt_expr->symtree->n.sym->attr.host_assoc
! || tgt_expr->symtree->n.sym->attr.if_source
! == IFSRC_DECL);
! permissible = permissible
! || (tgt_expr && tgt_expr->expr_type == EXPR_OP);
!
! if (permissible)
{
! gfc_resolve_expr (tgt_expr);
! sym->ts = tgt_expr->ts;
}
if (sym->ts.type == BT_UNKNOWN)
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 252894)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8396,8406 ****
--- 8396,8418 ----
sym->attr.subref_array_pointer = 1;
}
+ if (target->expr_type == EXPR_NULL)
+ {
+ gfc_error ("Selector at %L cannot be NULL()", &target->where);
+ return;
+ }
+ else if (target->ts.type == BT_UNKNOWN)
+ {
+ gfc_error ("Selector at %L has no type", &target->where);
+ return;
+ }
+
/* Get type if this was not already set. Note that it can be
some other type than the target in case this is a SELECT TYPE
selector! So we must not update when the type is already there. */
if (sym->ts.type == BT_UNKNOWN)
sym->ts = target->ts;
+
gcc_assert (sym->ts.type != BT_UNKNOWN);
/* See if this is a valid association-to-variable. */
*************** deferred_requirements (gfc_symbol *sym)
*** 11926,11931 ****
--- 11938,11944 ----
if (sym->ts.deferred
&& !(sym->attr.pointer
|| sym->attr.allocatable
+ || sym->attr.associate_var
|| sym->attr.omp_udr_artificial_var))
{
gfc_error ("Entity %qs at %L has a deferred type parameter and "
*************** resolve_symbol (gfc_symbol *sym)
*** 14763,14768 ****
--- 14776,14782 ----
if (class_attr.codimension
&& !(class_attr.allocatable || sym->attr.dummy || sym->attr.save
|| sym->attr.select_type_temporary
+ || sym->attr.associate_var
|| (sym->ns->save_all && !sym->attr.automatic)
|| sym->ns->proc_name->attr.flavor == FL_MODULE
|| sym->ns->proc_name->attr.is_main_program
Index: gcc/testsuite/gfortran.dg/associate_26.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_26.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_26.f90 (working copy)
***************
*** 0 ****
--- 1,15 ----
+ ! { dg-do compile }
+ ! { dg-options "-fcoarray=single" }
+ !
+ ! Test the fix for PR78152
+ !
+ ! Contributed by <physiker@toast2.net>
+ !
+ program co_assoc
+ implicit none
+ integer, parameter :: p = 5
+ real, allocatable :: a(:,:)[:,:]
+ allocate (a(p,p)[2,*])
+ associate (i => a(1:p, 1:p))
+ end associate
+ end program co_assoc
Index: gcc/testsuite/gfortran.dg/associate_27.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_27.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_27.f90 (working copy)
***************
*** 0 ****
--- 1,23 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR80120
+ !
+ ! Contributed by Marco Restelli <mrestelli@gmail.com>
+ !
+ program p
+ implicit none
+
+ type :: t
+ character(len=25) :: text(2)
+ end type t
+ type(t) :: x
+
+ x%text(1) = "ABC"
+ x%text(2) = "defgh"
+
+ associate( c => x%text )
+ if (c(1)(:maxval(len_trim(c))) .ne. trim (x%text(1))) call abort
+ if (c(2)(:maxval(len_trim(c))) .ne. trim (x%text(2))) call abort
+ end associate
+
+ end program p
Index: gcc/testsuite/gfortran.dg/associate_28.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_28.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_28.f90 (working copy)
***************
*** 0 ****
--- 1,64 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR81903
+ !
+ ! Contributed by Karl May <karl.may0@freenet.de>
+ !
+ Module TestMod_A
+ Type :: TestType_A
+ Real, Allocatable :: a(:,:)
+ End type TestType_A
+ End Module TestMod_A
+ Module TestMod_B
+ Type :: TestType_B
+ Real, Pointer, contiguous :: a(:,:)
+ End type TestType_B
+ End Module TestMod_B
+ Module TestMod_C
+ use TestMod_A
+ use TestMod_B
+ Implicit None
+ Type :: TestType_C
+ Class(TestType_A), Pointer :: TT_A(:)
+ Type(TestType_B), Allocatable :: TT_B(:)
+ contains
+ Procedure, Pass :: SetPt => SubSetPt
+ End type TestType_C
+ Interface
+ Module Subroutine SubSetPt(this)
+ class(TestType_C), Intent(InOut), Target :: this
+ End Subroutine
+ End Interface
+ End Module TestMod_C
+ Submodule(TestMod_C) SetPt
+ contains
+ Module Procedure SubSetPt
+ Implicit None
+ integer :: i
+ integer :: sum_a = 0
+ outer:block
+ associate(x=>this%TT_B,y=>this%TT_A)
+ Do i=1,size(x)
+ x(i)%a=>y(i)%a
+ sum_a = sum_a + sum (int (x(i)%a))
+ End Do
+ end associate
+ End block outer
+ if (sum_a .ne. 30) call abort
+ End Procedure
+ End Submodule SetPt
+ Program Test
+ use TestMod_C
+ use TestMod_A
+ Implicit None
+ Type(TestType_C) :: tb
+ Type(TestType_A), allocatable, Target :: ta(:)
+ integer :: i
+ real :: src(2,2) = reshape ([(real(i), i = 1,4)],[2,2])
+ allocate(ta(2),tb%tt_b(2))
+ do i=1,size(ta)
+ allocate(ta(i)%a(2,2), source = src*real(i))
+ End do
+ tb%TT_A=>ta
+ call tb%setpt()
+ End Program Test
Index: gcc/testsuite/gfortran.dg/associate_29.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_29.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_29.f90 (working copy)
***************
*** 0 ****
--- 1,30 ----
+ ! { dg-do compile }
+ !
+ ! Test the fix for PR82121
+ !
+ ! Contributed by Iain Miller <iain.miller@ecmwf.int>
+ !
+ MODULE YOMCDDH
+ IMPLICIT NONE
+ SAVE
+ TYPE :: TCDDH
+ CHARACTER(len=12),ALLOCATABLE :: CADHTLS(:)
+ END TYPE TCDDH
+ CHARACTER(len=12),ALLOCATABLE :: CADHTTS(:)
+ TYPE(TCDDH), POINTER :: YRCDDH => NULL()
+ END MODULE YOMCDDH
+
+
+ SUBROUTINE SUCDDH()
+ USE YOMCDDH , ONLY : YRCDDH,CADHTTS
+ IMPLICIT NONE
+ ALLOCATE (YRCDDH%CADHTLS(20))
+ ALLOCATE (CADHTTS(20))
+ ASSOCIATE(CADHTLS=>YRCDDH%CADHTLS, NORMCHAR=>CADHTTS)
+ ! Direct reference to character array compiled correctly
+ ! YRCDDH%CADHTLS(1)='SVGTLF'
+ ! Reference to associated variable name failed to compile
+ CADHTLS(2)='SVGTLT'
+ NORMCHAR(1)='SVLTTC'
+ END ASSOCIATE
+ END SUBROUTINE SUCDDH
Index: gcc/testsuite/gfortran.dg/associate_30.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_30.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_30.f90 (working copy)
***************
*** 0 ****
--- 1,15 ----
+ ! { dg-do compile }
+ !
+ ! Test the fix for PR67543
+ !
+ ! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
+ !
+ subroutine s1
+ associate (x => null()) ! { dg-error "cannot be NULL()" }
+ end associate
+ end subroutine
+
+ subroutine s2
+ associate (x => [null()]) ! { dg-error "has no type" }
+ end associate
+ end subroutine
Index: gcc/testsuite/gfortran.dg/associate_31.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_31.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_31.f90 (working copy)
***************
*** 0 ****
--- 1,39 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR52832
+ !
+ ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ subroutine testSub()
+ interface
+ integer function fcn1 (arg)
+ integer :: arg
+ end function
+ integer function fcn2 (arg)
+ integer :: arg
+ end function
+ end interface
+
+ procedure(fcn1), pointer :: r
+ r => fcn2
+ associate (k => r)
+ if (r(42) .ne. 84) call abort
+ end associate
+ r => fcn1
+ associate (k => r)
+ if (r(42) .ne. 42) call abort
+ end associate
+ end subroutine testSub
+
+ integer function fcn1 (arg)
+ integer :: arg;
+ fcn2 = arg
+ end function
+
+ integer function fcn2 (arg)
+ integer :: arg;
+ fcn2 = arg*2
+ end function
+
+ call testSub
+ end
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] Bug fixes, including regressions, for the associate construct
2017-09-20 16:45 [Patch, fortran] Bug fixes, including regressions, for the associate construct Paul Richard Thomas
@ 2017-09-21 0:52 ` Jerry DeLisle
2017-09-21 18:41 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Jerry DeLisle @ 2017-09-21 0:52 UTC (permalink / raw)
To: Paul Richard Thomas, fortran, gcc-patches
On 09/20/2017 09:45 AM, Paul Richard Thomas wrote:
> In the last update to the Parameterized Derived Types implementation,
> I fixed PR60483 as a side effect. I then checked all the ASSOCIATE
> bugs and noted that I was responsible for a number of regressions due
> to a patch that I applied last year. I determined to fix them and
> found that I couldn't stop.
>
> The PRs in the ChangeLogs are the low(ish) lying fruit and the changes
> are fairly obvious or are described in the ChangeLog or the comments.
>
> Bootstrapped and regtested on FC23/x86_64 - OK for trunk and later on 7-branch?
Yes OK and thanks for the fixes.
Cheers,
Jerry
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] Bug fixes, including regressions, for the associate construct
2017-09-21 0:52 ` Jerry DeLisle
@ 2017-09-21 18:41 ` Paul Richard Thomas
2017-09-22 8:12 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2017-09-21 18:41 UTC (permalink / raw)
To: Jerry DeLisle; +Cc: fortran, gcc-patches
Dear Jerry,
Thanks! Committed as revision 253077.
Cheers
Paul
On 21 September 2017 at 01:52, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 09/20/2017 09:45 AM, Paul Richard Thomas wrote:
>> In the last update to the Parameterized Derived Types implementation,
>> I fixed PR60483 as a side effect. I then checked all the ASSOCIATE
>> bugs and noted that I was responsible for a number of regressions due
>> to a patch that I applied last year. I determined to fix them and
>> found that I couldn't stop.
>>
>> The PRs in the ChangeLogs are the low(ish) lying fruit and the changes
>> are fairly obvious or are described in the ChangeLog or the comments.
>>
>> Bootstrapped and regtested on FC23/x86_64 - OK for trunk and later on 7-branch?
>
> Yes OK and thanks for the fixes.
>
>
> Cheers,
>
> Jerry
>
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] Bug fixes, including regressions, for the associate construct
2017-09-21 18:41 ` Paul Richard Thomas
@ 2017-09-22 8:12 ` Paul Richard Thomas
0 siblings, 0 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2017-09-22 8:12 UTC (permalink / raw)
To: Jerry DeLisle; +Cc: fortran, gcc-patches
Dear All,
I seem to have messed up associate_31.f90 totally. Not only is it not
doing the intended test but it is failing at all levels of
optimization. I will remove it first thing tomorrow. Strangely, it did
not fail when I regtested before committing.
Sorry about this.
Paul
On 21 September 2017 at 19:41, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Jerry,
>
> Thanks! Committed as revision 253077.
>
> Cheers
>
> Paul
>
> On 21 September 2017 at 01:52, Jerry DeLisle <jvdelisle@charter.net> wrote:
>> On 09/20/2017 09:45 AM, Paul Richard Thomas wrote:
>>> In the last update to the Parameterized Derived Types implementation,
>>> I fixed PR60483 as a side effect. I then checked all the ASSOCIATE
>>> bugs and noted that I was responsible for a number of regressions due
>>> to a patch that I applied last year. I determined to fix them and
>>> found that I couldn't stop.
>>>
>>> The PRs in the ChangeLogs are the low(ish) lying fruit and the changes
>>> are fairly obvious or are described in the ChangeLog or the comments.
>>>
>>> Bootstrapped and regtested on FC23/x86_64 - OK for trunk and later on 7-branch?
>>
>> Yes OK and thanks for the fixes.
>>
>>
>> Cheers,
>>
>> Jerry
>>
>
>
>
> --
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2017-09-22 8:12 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-20 16:45 [Patch, fortran] Bug fixes, including regressions, for the associate construct Paul Richard Thomas
2017-09-21 0:52 ` Jerry DeLisle
2017-09-21 18:41 ` Paul Richard Thomas
2017-09-22 8:12 ` 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).