This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR60898 premature release of entry symbols


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

Attachment: pr60898.CL
Description: Text document

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 <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







Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]