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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e61ad02..85eb3bb 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2015-03-08  Mikael Morin  <mikael@gcc.gnu.org>
+
+       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  <burnus@net-b.de>
 
        * 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 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-08  Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/60898
+       * gfortran.dg/entry_20.f90: New.
+
 2015-03-07  Oleg Endo  <olegendo@gcc.gnu.org>
 
        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 (file)
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 <shaojuncycle@gmail.com>
+
+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
+