From 9bdaf61630a9aea0116ade602ecef9b49590794c Mon Sep 17 00:00:00 2001 From: tkoenig Date: Sat, 24 Nov 2012 17:13:25 +0000 Subject: [PATCH] 2012-11-24 Thomas Koenig PR fortran/55314 Backport from trunk * resolve.c (resolve_allocate_deallocate): Compare all subscripts when deciding if to reject a (de)allocate statement. 2012-11-24 Thomas Koenig PR fortran/55314 Backport from trunk * gfortran.dg/allocate_error_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@193780 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/resolve.c | 19 ++++++++++++++----- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/allocate_error_4.f90 | 16 ++++++++++++++++ 4 files changed, 44 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_error_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 380be47eddc..e2766538360 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2012-11-24 Thomas Koenig + + PR fortran/55314 + Backport from trunk + * resolve.c (resolve_allocate_deallocate): Compare all + subscripts when deciding if to reject a (de)allocate + statement. + 2012-11-23 Janus Weil PR fortran/55352 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 33913aa8634..bbc1c2208fb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7280,8 +7280,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) } } - /* Check that an allocate-object appears only once in the statement. - FIXME: Checking derived types is disabled. */ + /* Check that an allocate-object appears only once in the statement. */ + for (p = code->ext.alloc.list; p; p = p->next) { pe = p->expr; @@ -7329,11 +7329,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 (gfc_dep_compare_expr (par->start[0], - qar->start[0]) != 0) - break; + + for (i=0; idimen; 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 @@ -7345,6 +7352,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) pr = pr->next; qr = qr->next; } + break_label: + ; } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bf76bc7e214..d5dd4719eba 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2012-11-24 Thomas Koenig + + PR fortran/55314 + Backport from trunk + * gfortran.dg/allocate_error_4.f90: New test. + 2012-11-23 Janus Weil PR fortran/55352 diff --git a/gcc/testsuite/gfortran.dg/allocate_error_4.f90 b/gcc/testsuite/gfortran.dg/allocate_error_4.f90 new file mode 100644 index 00000000000..6652b472f49 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_error_4.f90 @@ -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 -- 2.11.0