From 511820a8dc2a5f750cadd76456f4aac4dd0b640d Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Sun, 8 Mar 2015 11:52:51 +0000 Subject: [PATCH] re PR fortran/60898 (model compile error with gfortran 4.7 and gcc 4.9) PR fortran/60898 fortran/ * resolve.c (resolve_symbol): Check that the symbol found by name lookup really is the current symbol being resolved. testsuite/ * gfortran.dg/entry_20.f90: New. From-SVN: r221262 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/resolve.c | 11 ++- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/entry_20.f90 | 148 +++++++++++++++++++++++++++++++++ 4 files changed, 166 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/entry_20.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e61ad02..85eb3bb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2015-03-08 Mikael Morin + + PR fortran/60898 + * resolve.c (resolve_symbol): Check that the symbol found by + name lookup really is the current symbol being resolved. + 2015-03-02 Tobias Burnus * check.c (gfc_check_atomic): Properly check for coarrayness diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 675cb15..942a9ad 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13125,10 +13125,13 @@ resolve_symbol (gfc_symbol *sym) { this_symtree = gfc_find_symtree (gfc_current_ns->sym_root, sym->name); - gfc_release_symbol (sym); - symtree->n.sym->refs++; - this_symtree->n.sym = symtree->n.sym; - return; + if (this_symtree->n.sym == sym) + { + symtree->n.sym->refs++; + gfc_release_symbol (sym); + this_symtree->n.sym = symtree->n.sym; + return; + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e303a39..eb9f0df 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-03-08 Morin + + PR fortran/60898 + * gfortran.dg/entry_20.f90: New. + 2015-03-07 Oleg Endo PR target/65153 diff --git a/gcc/testsuite/gfortran.dg/entry_20.f90 b/gcc/testsuite/gfortran.dg/entry_20.f90 new file mode 100644 index 0000000..1069d1e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_20.f90 @@ -0,0 +1,148 @@ +! { dg-do compile } +! +! PR fortran/50898 +! A symbol was freed prematurely during resolution, +! despite remaining reachable +! +! Original testcase from + +MODULE MODULE_pmat2 + +IMPLICIT NONE + +INTERFACE cad1b; MODULE PROCEDURE cad1b; END INTERFACE +INTERFACE csb1b; MODULE PROCEDURE csb1b; END INTERFACE +INTERFACE copbt; MODULE PROCEDURE copbt; END INTERFACE +INTERFACE conbt; MODULE PROCEDURE conbt; END INTERFACE +INTERFACE copmb; MODULE PROCEDURE copmb; END INTERFACE +INTERFACE conmb; MODULE PROCEDURE conmb; END INTERFACE +INTERFACE copbm; MODULE PROCEDURE copbm; END INTERFACE +INTERFACE conbm; MODULE PROCEDURE conbm; END INTERFACE +INTERFACE mulvb; MODULE PROCEDURE mulvb; END INTERFACE +INTERFACE madvb; MODULE PROCEDURE madvb; END INTERFACE +INTERFACE msbvb; MODULE PROCEDURE msbvb; END INTERFACE +INTERFACE mulxb; MODULE PROCEDURE mulxb; END INTERFACE +INTERFACE madxb; MODULE PROCEDURE madxb; END INTERFACE +INTERFACE msbxb; MODULE PROCEDURE msbxb; END INTERFACE + +integer, parameter :: i_kind=4 +integer, parameter :: r_kind=4 +real(r_kind), parameter :: zero=0.0 +real(r_kind), parameter :: one=1.0 +real(r_kind), parameter :: two=2.0 + +CONTAINS + +SUBROUTINE cad1b(a,m1,mah1,mah2,mirror2) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1,mah1,mah2,mirror2 +REAL(r_kind), INTENT(INOUT) :: a(0:m1-1,-mah1:mah2) +RETURN +ENTRY csb1b(a,m1,mah1,mah2,mirror2) +END SUBROUTINE cad1b + +SUBROUTINE copbt(a,b,m1,m2,mah1,mah2) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2 +REAL(r_kind), INTENT(IN ) :: a(m1,-mah1:mah2) +REAL(r_kind), INTENT( OUT) :: b(m2,-mah2:mah1) +RETURN +ENTRY conbt(a,b,m1,m2,mah1,mah2) +END SUBROUTINE copbt + +SUBROUTINE copmb(afull,aband,m1,m2,mah1,mah2) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2 +REAL(r_kind), DIMENSION(m1,m2), INTENT(IN ) :: afull +REAL(r_kind), DIMENSION(m1,-mah1:mah2),INTENT( OUT) :: aband +RETURN +ENTRY conmb(afull,aband,m1,m2,mah1,mah2) +END SUBROUTINE copmb + +SUBROUTINE copbm(aband,afull,m1,m2,mah1,mah2) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2 +REAL(r_kind), DIMENSION(m1,-mah1:mah2),INTENT(IN ) :: aband +REAL(r_kind), DIMENSION(m1,m2), INTENT( OUT) :: afull +RETURN +ENTRY conbm(aband,afull,m1,m2,mah1,mah2) +END SUBROUTINE copbm + +SUBROUTINE mulbb(a,b,c,m1,m2,mah1,mah2,mbh1,mbh2,mch1,mch2) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2, mbh1, mbh2, mch1, mch2 +REAL(r_kind), INTENT(IN ) :: a(m1,-mah1:mah2), b(m2,-mbh1:mbh2) +REAL(r_kind), INTENT(INOUT) :: c(m1,-mch1:mch2) +INTEGER(i_kind) :: nch1, nch2, j, k, jpk, i1,i2 +c=zero +ENTRY madbb(a,b,c,m1,m2,mah1,mah2,mbh1,mbh2,mch1,mch2) +nch1=mah1+mbh1; nch2=mah2+mbh2 +IF(nch1 /= mch1 .OR. nch2 /= mch2)STOP 'In MULBB, dimensions inconsistent' +DO j=-mah1,mah2 + DO k=-mbh1,mbh2; jpk=j+k; i1=MAX(1,1-j); i2=MIN(m1,m2-j) + c(i1:i2,jpk)=c(i1:i2,jpk)+a(i1:i2,j)*b(j+i1:j+i2,k) + ENDDO +ENDDO +END SUBROUTINE mulbb + +SUBROUTINE MULVB(v1,a,v2, m1,m2,mah1,mah2) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2 +REAL(r_kind), INTENT(IN ) :: v1(m1), a(m1,-mah1:mah2) +REAL(r_kind), INTENT( OUT) :: v2(m2) +INTEGER(i_kind) :: j, i1,i2 +v2=zero +ENTRY madvb(v1,a,v2, m1,m2,mah1,mah2) +DO j=-mah1,mah2; i1=MAX(1,1-j); i2=MIN(m1,m2-j) + v2(j+i1:j+i2)=v2(j+i1:j+i2)+v1(i1:i2)*a(i1:i2,j) +ENDDO +RETURN +ENTRY msbvb(v1,a,v2, m1,m2,mah1,mah2) +DO j=-mah1,mah2; i1=MAX(1,1-j); i2=MIN(m1,m2-j) + v2(j+i1:j+i2)=v2(j+i1:j+i2)-v1(i1:i2)*a(i1:i2,j) +ENDDO +END SUBROUTINE mulvb + +SUBROUTINE mulxb(v1,a,v2, m1,m2,mah1,mah2,my) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2, my +REAL(r_kind), INTENT(IN ) :: v1(m1,my), a(m1,-mah1:mah2) +REAL(r_kind), INTENT( OUT) :: v2(m2,my) +INTEGER(i_kind) :: i,j +v2=zero +ENTRY madxb(v1,a,v2, m1,m2,mah1,mah2,my) +DO j=-mah1,mah2 + DO i=MAX(1,1-j),MIN(m1,m2-j); v2(j+i,:)=v2(j+i,:)+v1(i,:)*a(i,j); ENDDO +ENDDO +RETURN +ENTRY msbxb(v1,a,v2, m1,m2,mah1,mah2,my) +DO j=-mah1,mah2 + DO i=MAX(1,1-j),MIN(m1,m2-j); v2(j+i,:)=v2(j+i,:)-v1(i,:)*a(i,j); ENDDO +ENDDO +END SUBROUTINE mulxb + +SUBROUTINE mulyb(v1,a,v2, m1,m2,mah1,mah2,mx) +implicit none +INTEGER(i_kind), INTENT(IN ) :: m1, m2, mah1, mah2, mx +REAL(r_kind), INTENT(IN ) :: v1(mx,m1), a(m1,-mah1:mah2) +REAL(r_kind), INTENT( OUT) :: v2(mx,m2) +INTEGER(i_kind) :: i,j +v2=zero +ENTRY madyb(v1,a,v2, m1,m2,mah1,mah2,mx) +DO j=-mah1,mah2 + DO i=MAX(1,1-j),MIN(m1,m2-j) + v2(:,j+i)=v2(:,j+i)+v1(:,i)*a(i,j) + ENDDO +ENDDO +RETURN +ENTRY msbyb(v1,a,v2, m1,m2,mah1,mah2,mx) + DO j=-mah1,mah2 + DO i=MAX(1,1-j),MIN(m1,m2-j) + v2(:,j+i)=v2(:,j+i)-v1(:,i)*a(i,j) + ENDDO + ENDDO +RETURN +END SUBROUTINE mulyb + +END MODULE MODULE_pmat2 + -- 2.7.4