OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/44556 (incorrect error: Stat-variable at (1) shall not be DEALLOCATEd within the same DEALLOCATE statement)

Browse Source 
2010-06-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44556
        * resolve.c (resolve_allocate_deallocate): Properly check
        part-refs in stat=/errmsg= for invalid use.

2010-06-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44556
        * gfortran.dg/allocate_alloc_opt_11.f90: New.

From-SVN: r161011
This commit is contained in:
Tobias Burnus 2010-06-19 00:23:40 +02:00 committed by Tobias Burnus
parent ca0cb93e34
commit ddf58e42fe
4 changed files with 83 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2010-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/44556
* resolve.c (resolve_allocate_deallocate): Properly check
part-refs in stat=/errmsg= for invalid use.
2010-06-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/44558

50
gcc/fortran/resolve.c
View File

@ -6591,8 +6591,29 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
for (p = code->ext.alloc.list; p; p = p->next)
if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
gfc_error ("Stat-variable at %L shall not be %sd within "
"the same %s statement", &stat->where, fcn, fcn);
{
gfc_ref *ref1, *ref2;
bool found = true;
for (ref1 = p->expr->ref, ref2 = stat->ref; ref1 && ref2;
ref1 = ref1->next, ref2 = ref2->next)
{
if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT)
continue;
if (ref1->u.c.component->name != ref2->u.c.component->name)
{
found = false;
break;
}
}
if (found)
{
gfc_error ("Stat-variable at %L shall not be %sd within "
"the same %s statement", &stat->where, fcn, fcn);
break;
}
}
}
/* Check the errmsg variable. */
@ -6620,8 +6641,29 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
for (p = code->ext.alloc.list; p; p = p->next)
if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
gfc_error ("Errmsg-variable at %L shall not be %sd within "
"the same %s statement", &errmsg->where, fcn, fcn);
{
gfc_ref *ref1, *ref2;
bool found = true;
for (ref1 = p->expr->ref, ref2 = errmsg->ref; ref1 && ref2;
ref1 = ref1->next, ref2 = ref2->next)
{
if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT)
continue;
if (ref1->u.c.component->name != ref2->u.c.component->name)
{
found = false;
break;
}
}
if (found)
{
gfc_error ("Errmsg-variable at %L shall not be %sd within "
"the same %s statement", &errmsg->where, fcn, fcn);
break;
}
}
}
/* Check that an allocate-object appears only once in the statement.

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/44556
* gfortran.dg/allocate_alloc_opt_11.f90: New.
2010-06-18 Bernd Schmidt <bernds@codesourcery.com>
* gcc.target/arm/pr40900.c: New test.

26
gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do compile }
!
! PR fortran/44556
!
! Contributed by Jonathan Hogg and Steve Kargl.
!
program oh_my
implicit none
type a
integer, allocatable :: b(:), d(:)
character(len=80) :: err
character(len=80), allocatable :: str(:)
integer :: src
end type a
integer j
type(a) :: c
c%err = 'ok'
allocate(c%d(1))
allocate(c%b(2), errmsg=c%err, stat=c%d(1)) ! OK
deallocate(c%b, errmsg=c%err, stat=c%d(1)) ! OK
allocate(c%b(2), errmsg=c%err, stat=c%b(1)) ! { dg-error "the same ALLOCATE statement" }
deallocate(c%b, errmsg=c%err, stat=c%b(1)) ! { dg-error "the same DEALLOCATE statement" }
allocate(c%str(2), errmsg=c%str(1), stat=j) ! { dg-error "the same ALLOCATE statement" }
deallocate(c%str, errmsg=c%str(1), stat=j) ! { dg-error "the same DEALLOCATE statement" }
end program oh_my