re PR fortran/55314 (Rejects some valid ALLOCATE statements)

2012-11-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/55314
	* resolve.c (resolve_allocate_deallocate):  Compare all
	subscripts when deciding if to reject a (de)allocate
	statement.

2012-11-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/55314
	* gfortran.dg/allocate_error_4.f90:  New test.

From-SVN: r193778
This commit is contained in:
Thomas Koenig 2012-11-24 15:00:16 +00:00
parent 59ad52e0fb
commit 02bfa7081e
4 changed files with 40 additions and 4 deletions

View File

@ -1,3 +1,10 @@
2012-11-24 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55314
* resolve.c (resolve_allocate_deallocate): Compare all
subscripts when deciding if to reject a (de)allocate
statement.
2012-11-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/55352

View File

@ -7622,12 +7622,18 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
if (pr->next && qr->next)
{
int i;
gfc_array_ref *par = &(pr->u.ar);
gfc_array_ref *qar = &(qr->u.ar);
if ((par->start[0] != NULL || qar->start[0] != NULL)
&& gfc_dep_compare_expr (par->start[0],
qar->start[0]) != 0)
break;
for (i=0; i<par->dimen; i++)
{
if ((par->start[i] != NULL
|| qar->start[i] != NULL)
&& gfc_dep_compare_expr (par->start[i],
qar->start[i]) != 0)
goto break_label;
}
}
}
else
@ -7639,6 +7645,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
pr = pr->next;
qr = qr->next;
}
break_label:
;
}
}
}

View File

@ -1,3 +1,8 @@
2012-11-24 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55314
* gfortran.dg/allocate_error_4.f90: New test.
2012-11-24 Hans-Peter Nilsson <hp@bitrange.com>
* lib/gcc-gdb-test.exp (gdb-test): Pass -- as first argument

View File

@ -0,0 +1,16 @@
! { dg-do compile }
! PR fortran/55314 - the second allocate statement was rejected.
program main
implicit none
integer :: max_nb
type comm_mask
integer(4), pointer :: mask(:)
end type comm_mask
type (comm_mask), allocatable, save :: encode(:,:)
max_nb=2
allocate( encode(1:1,1:max_nb))
allocate( encode(1,1)%mask(1),encode(1,2)%mask(1))
deallocate( encode(1,1)%mask,encode(1,2)%mask)
allocate( encode(1,1)%mask(1),encode(1,1)%mask(1)) ! { dg-error "also appears at" }
end program main