From ddf58e42fe46db1cf05f21f61fc05f2d2107d5d5 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 19 Jun 2010 00:23:40 +0200 Subject: [PATCH] re PR fortran/44556 (incorrect error: Stat-variable at (1) shall not be DEALLOCATEd within the same DEALLOCATE statement) 2010-06-18 Tobias Burnus PR fortran/44556 * resolve.c (resolve_allocate_deallocate): Properly check part-refs in stat=/errmsg= for invalid use. 2010-06-18 Tobias Burnus PR fortran/44556 * gfortran.dg/allocate_alloc_opt_11.f90: New. From-SVN: r161011 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/resolve.c | 50 ++++++++++++++++++++-- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/allocate_alloc_opt_11.f90 | 26 +++++++++++ 4 files changed, 83 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 11bda1f..dfaeeec 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-06-18 Tobias Burnus + + PR fortran/44556 + * resolve.c (resolve_allocate_deallocate): Properly check + part-refs in stat=/errmsg= for invalid use. + 2010-06-17 Janus Weil PR fortran/44558 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 52920f4..0951498 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ce75762..2ac6bd6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-18 Tobias Burnus + + PR fortran/44556 + * gfortran.dg/allocate_alloc_opt_11.f90: New. + 2010-06-18 Bernd Schmidt * gcc.target/arm/pr40900.c: New test. diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 new file mode 100644 index 0000000..c8c7ac6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 @@ -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 -- 2.7.4