Hello,
I propose a fix for PR60898, where a symbol is freed despite remaining
reachable in the symbol tree.
The problem comes from this code in resolve_symbol:
>
> /* If we find that a flavorless symbol is an interface in one of the
> parent namespaces, find its symtree in this namespace, free the
> symbol and set the symtree to point to the interface symbol. */
> for (ns = gfc_current_ns->parent; ns; ns = ns->parent)
> {
> symtree = gfc_find_symtree (ns->sym_root, sym->name);
> if (symtree && [...])
> {
> 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;
> }
> }
>
Here, the target of an element of the current namespace's name tree is
changed to point to the outer symbol. And the current symbol is freed,
without checking that it really was what was in the name tree before.
In the testcase https://gcc.gnu.org/bugzilla/show_bug.cgi?id=60898#c7 ,
the problematic symbol is an entry, which is available in the name tree
only through a mangled name (created by gfc_get_unique_symtree in
get_proc_name), so gfc_find_symtree won't find it by name lookup.
In this case, what gfc_find_symtree finds is a symbol that is already
the outer interface symbol, so reassigning this_symtree.n.sym would be a
no-op.
The patch proposed checks that sym == this_symtree->n.sym, so that the
symbol reassignment is only made in that case. Otherwise, the regular
symbol resolution happens normally.
This patch is a stripped down version of what I posted before in the PR,
which contained a symbol.c part which was increasing the reference count
locally in do_traverse_symtree, to delay symbol release after all of
them have been processed. That part was useless because if a symbol had
to be processed more than once (meaning it was available under different
names), it will have the corresponding reference count set so that it
won't be freed too early in any case.
Worse, that part was interacting badly with the hack used to break
circular references in gfc_release_symbol, so it was better left out.
Anyway, this is regression tested[*] on x86_64-unknown-linux-gnu. OK for
trunk/4.9/4.8 ?
Mikael
[*] I have a few failing testcases (also without the patch), namely the
following; does this ring a bell ?
FAIL: gfortran.dg/erf_3.F90
FAIL: gfortran.dg/fmt_g0_7.f08
FAIL: gfortran.dg/fmt_en.f90
FAIL: gfortran.dg/nan_7.f90
FAIL: gfortran.dg/quad_2.f90
FAIL: gfortran.dg/quad_3.f90
FAIL: gfortran.dg/round_4.f90
2015-02-15 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/60898
* resolve.c (resolve_symbol): Check that the symbol found from
name lookup really is the current symbol being resolved.
2015-02-15 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/60898
* gfortran.dg/entry_20.f90: New.
Index: resolve.c
===================================================================
--- resolve.c (révision 220514)
+++ resolve.c (copie de travail)
@@ -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;
+ }
}
}
! { dg-do compile }
!
! PR fortran/50898
! A symbol was freed prematurely during resolution,
! despite remaining reachable
!
! Original testcase from <shaojuncy...@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
