procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

Browse source 
2011-08-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * parse.c (parse_derived): Add lock_type
        checks, improve coarray_comp handling.
        * resolve.c (resolve_allocate_expr,
        resolve_lock_unlock, resolve_symbol): Fix lock_type
        constraint checks.

2011-08-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_lock_1.f90: Update dg-error.
        * gfortran.dg/coarray_lock_3.f90: Fix test.
        * gfortran.dg/coarray_lock_4.f90: New.
        * gfortran.dg/coarray_lock_5.f90: New.

From-SVN: r177867
This commit is contained in:
Tobias Burnus 2011-08-18 17:10:25 +02:00 • committed by Tobias Burnus
parent a1998fab44
commit 3b6fa7a5c6
8 changed files with 246 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
2011-08-18 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* parse.c (parse_derived): Add lock_type
checks, improve coarray_comp handling.
* resolve.c (resolve_allocate_expr,
resolve_lock_unlock, resolve_symbol): Fix lock_type
constraint checks.
2011-08-17 Tobias Burnus <burnus@net-b.de>
PR fortran/31461

88
gcc/fortran/parse.c
View file

@ -2018,7 +2018,7 @@ parse_derived (void)
gfc_statement st;
gfc_state_data s;
gfc_symbol *sym;
gfc_component *c;
gfc_component *c, *lock_comp = NULL;
accept_statement (ST_DERIVED_DECL);
push_state (&s, COMP_DERIVED, gfc_new_block);
@ -2126,19 +2126,28 @@ endType:
sym = gfc_current_block ();
for (c = sym->components; c; c = c->next)
{
bool coarray, lock_type, allocatable, pointer;
coarray = lock_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->ts.u.derived->attr.alloc_comp))
sym->attr.alloc_comp = 1;
{
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))
sym->attr.pointer_comp = 1;
{
pointer = true;
sym->attr.pointer_comp = 1;
}
/* Look for procedure pointer components. */
if (c->attr.proc_pointer
@ -2148,15 +2157,76 @@ endType:
/* Looking for coarray components. */
if (c->attr.codimension
|| (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable))
sym->attr.coarray_comp = 1;
|| (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)
{
coarray = true;
if (!pointer && !allocatable)
sym->attr.coarray_comp = 1;
}
/* Looking for lock_type components. */
if (c->attr.lock_comp
|| (sym->ts.type == BT_DERIVED
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))
sym->attr.lock_comp = 1;
&& 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;
}
/* 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);
/* Look for private components. */
if (sym->component_access == ACCESS_PRIVATE

21
gcc/fortran/resolve.c
View file

@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
/* Check F2008, C642. */
if (code->expr3->ts.type == BT_DERIVED
&& ((codimension && gfc_expr_attr (code->expr3).lock_comp)
&& ((codimension && gfc_expr_attr (code->expr3).lock_comp)
|| (code->expr3->ts.u.derived->from_intmod
== INTMOD_ISO_FORTRAN_ENV
&& code->expr3->ts.u.derived->intmod_sym_id
@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code)
|| code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
|| code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
|| code->expr1->rank != 0
|| !(gfc_expr_attr (code->expr1).codimension
|| gfc_is_coindexed (code->expr1)))
gfc_error ("Lock variable at %L must be a scalar coarray of type "
"LOCK_TYPE", &code->expr1->where);
|| (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code->expr1)))
gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
&code->expr1->where);
/* Check STAT. */
if (code->expr2
@ -12221,12 +12220,14 @@ resolve_symbol (gfc_symbol *sym)
/* F2008, C1302. */
if (sym->ts.type == BT_DERIVED
&& sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
&& sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
&& !sym->attr.codimension)
&& ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
&& sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
|| sym->ts.u.derived->attr.lock_comp)
&& !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
{
gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
sym->name, &sym->declared_at);
gfc_error ("Variable %s at %L of type LOCK_TYPE or with subcomponent of "
"type LOCK_TYPE must be a coarray", sym->name,
&sym->declared_at);
return;
}

8
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,11 @@
2011-08-18 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_lock_1.f90: Update dg-error.
* gfortran.dg/coarray_lock_3.f90: Fix test.
* gfortran.dg/coarray_lock_4.f90: New.
* gfortran.dg/coarray_lock_5.f90: New.
2011-08-18 Jakub Jelinek <jakub@redhat.com>
PR target/50009

4
gcc/testsuite/gfortran.dg/coarray_lock_1.f90
View file

@ -10,6 +10,6 @@ integer :: s
character(len=3) :: c
logical :: bool
LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
end

30
gcc/testsuite/gfortran.dg/coarray_lock_3.f90
View file

@ -19,12 +19,22 @@ module m
type t
type(lock_type), allocatable :: x(:)[:]
end type t
type t2
type(lock_type), allocatable :: x
end type t2
end module m
module m2
use iso_fortran_env
type t2
type(lock_type), allocatable :: x ! { dg-error "Allocatable component x at .1. of type LOCK_TYPE must have a codimension" }
end type t2
end module m2
module m3
use iso_fortran_env
type t3
type(lock_type) :: x ! OK
end type t3
end module m3
subroutine sub(x)
use iso_fortran_env
type(lock_type), intent(out) :: x[*] ! OK
@ -46,15 +56,15 @@ subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, n
end subroutine sub3
subroutine sub4(x)
use m
type(t2), intent(inout) :: x[*] ! OK
use m3
type(t3), intent(inout) :: x[*] ! OK
end subroutine sub4
subroutine lock_test
use iso_fortran_env
type t
end type t
type(lock_type) :: lock ! { dg-error "type LOCK_TYPE must be a coarray" }
type(lock_type) :: lock ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
end subroutine lock_test
subroutine lock_test2
@ -65,10 +75,10 @@ subroutine lock_test2
type(t) :: x
type(lock_type), save :: lock[*],lock2(2)[*]
lock(t) ! { dg-error "Syntax error in LOCK statement" }
lock(x) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" }
lock(lock)
lock(lock2(1))
lock(lock2) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" }
lock(lock[1]) ! OK
end subroutine lock_test2
@ -104,4 +114,4 @@ contains
end subroutine test
end subroutine argument_check
! { dg-final { cleanup-modules "m" } }
! { dg-final { cleanup-modules "m m2 m3" } }

64
gcc/testsuite/gfortran.dg/coarray_lock_4.f90 Normal file
View file

@ -0,0 +1,64 @@
! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
!
! LOCK/LOCK_TYPE checks
!
subroutine valid()
use iso_fortran_env
implicit none
type t
type(lock_type) :: lock
end type t
type t2
type(lock_type), allocatable :: lock(:)[:]
end type t2
type(t), save :: a[*]
type(t2), save :: b ! OK
allocate(b%lock(1)[*])
LOCK(a%lock) ! OK
LOCK(a[1]%lock) ! OK
LOCK(b%lock(1)) ! OK
LOCK(b%lock(1)[1]) ! OK
end subroutine valid
subroutine invalid()
use iso_fortran_env
implicit none
type t
type(lock_type) :: lock
end type t
type(t), save :: a ! { dg-error "type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
end subroutine invalid
subroutine more_tests
use iso_fortran_env
implicit none
type t
type(lock_type) :: a ! OK
end type t
type t1
type(lock_type), allocatable :: c2(:)[:] ! OK
end type t1
type(t1) :: x1 ! OK
type t2
type(lock_type), allocatable :: c1(:) ! { dg-error "Allocatable component c1 at .1. of type LOCK_TYPE must have a codimension" }
end type t2
type t3
type(t) :: b
end type t3
type(t3) :: x3 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
type t4
type(lock_type) :: c0(2)
end type t4
type(t4) :: x4 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
end subroutine more_tests

53
gcc/testsuite/gfortran.dg/coarray_lock_5.f90 Normal file
View file

@ -0,0 +1,53 @@
! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
! LOCK_TYPE checks
!
module m3
use iso_fortran_env
type, extends(lock_type) :: lock
integer :: j = 7
end type lock
end module m3
use m3
type(lock_type) :: tl[*] = lock_type ()
type(lock) :: t[*]
tl = lock_type () ! { dg-error "variable definition context" }
print *,t%j
end
subroutine test()
use iso_fortran_env
type t
type(lock_type) :: lock
end type t
type t2
type(t), pointer :: x ! { dg-error "Pointer component x at .1. has a noncoarray subcomponent of type LOCK_TYPE, which must have a codimension or be a subcomponent of a coarray" }
end type t2
end subroutine test
subroutine test2()
use iso_fortran_env
implicit none
type t
type(lock_type), allocatable :: lock ! { dg-error "Allocatable component lock at .1. of type LOCK_TYPE must have a codimension" }
end type t
type t2
type(lock_type) :: lock
end type t2
type t3
type(t2), allocatable :: lock_cmp
end type t3
type t4
integer, allocatable :: a[:]
type(t2) :: b ! { dg-error "Noncoarray component b at .1. 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 t4 may not have a codimension as already a coarray subcomponent exists." }
end type t4
type t5
type(t2) :: c ! { dg-error "Noncoarray component c at .1. 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 t5 may not have a codimension as d at .2. has a codimension or a coarray subcomponent." }
integer, allocatable :: d[:] ! { dg-error "Noncoarray component c at .1. 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 t5 may not have a codimension as d at .2. has a codimension or a coarray subcomponent." }
end type t5
end subroutine test2
! { dg-final { cleanup-modules "m3" } }