diff mbox

patch fortran, pr 59746, internal compiler error : segmentation fault

Message ID 55B91D0D.2020606@sfr.fr
State New
Headers show

Commit Message

Mikael Morin July 29, 2015, 6:35 p.m. UTC 
Hello,

I'm unburrying the patch from the thread starting at:
https://gcc.gnu.org/ml/gcc-patches/2014-03/msg00439.html

I provide the patch in two flavors read-only (without whitespace 
changes) and  write-only (with them).
This has been tested on x86_64-unknown-linux-gnu.  OK for trunk?

Mikael
2015-07-29  Bud Davis  <jmdavis@link.com>
	    Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/59746
	* symbol.c (gfc_restore_last_undo_checkpoint): Delete a common block
	symbol if it was put in the list.

2015-07-29  Bud Davis  <jmdavis@link.com>

	PR fortran/59746
	* gfortran.dg/common_22.f90: New.

Comments

Mikael Morin Aug. 6, 2015, 10:11 a.m. UTC | #1 
Le 29/07/2015 20:35, Mikael Morin a écrit :
> Hello,
>
> I'm unburrying the patch from the thread starting at:
> https://gcc.gnu.org/ml/gcc-patches/2014-03/msg00439.html
>
> I provide the patch in two flavors read-only (without whitespace
> changes) and  write-only (with them).
> This has been tested on x86_64-unknown-linux-gnu.  OK for trunk?
>

Ping: https://gcc.gnu.org/ml/gcc-patches/2015-07/msg02494.html
Paul Richard Thomas Aug. 6, 2015, 10:28 a.m. UTC | #2 
Hi Mikael,

This is OK for trunk.

Thanks for resurrecting the patch.

Cheers

Paul

On 6 August 2015 at 12:11, Mikael Morin <mikael.morin@sfr.fr> wrote:
> Le 29/07/2015 20:35, Mikael Morin a écrit :
>>
>> Hello,
>>
>> I'm unburrying the patch from the thread starting at:
>> https://gcc.gnu.org/ml/gcc-patches/2014-03/msg00439.html
>>
>> I provide the patch in two flavors read-only (without whitespace
>> changes) and  write-only (with them).
>> This has been tested on x86_64-unknown-linux-gnu.  OK for trunk?
>>
>
> Ping: https://gcc.gnu.org/ml/gcc-patches/2015-07/msg02494.html
diff mbox

Patch

Index: fortran/symbol.c
===================================================================
*** fortran/symbol.c	(révision 226157)
--- fortran/symbol.c	(copie de travail)
***************
*** 3168,3216 ****
  
    FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
      {
!       if (p->gfc_new)
  	{
! 	  /* Symbol was new.  */
! 	  if (p->attr.in_common && p->common_block && p->common_block->head)
! 	    {
! 	      /* If the symbol was added to any common block, it
! 		 needs to be removed to stop the resolver looking
! 		 for a (possibly) dead symbol.  */
  
! 	      if (p->common_block->head == p && !p->common_next)
  		{
! 		  gfc_symtree st, *st0;
! 		  st0 = find_common_symtree (p->ns->common_root,
! 					     p->common_block);
! 		  if (st0)
! 		    {
! 		      st.name = st0->name;
! 		      gfc_delete_bbt (&p->ns->common_root, &st, compare_symtree);
! 		      free (st0);
! 		    }
  		}
  
! 	      if (p->common_block->head == p)
! 	        p->common_block->head = p->common_next;
! 	      else
! 		{
! 		  gfc_symbol *cparent, *csym;
! 
! 		  cparent = p->common_block->head;
! 		  csym = cparent->common_next;
! 
! 		  while (csym != p)
! 		    {
! 		      cparent = csym;
! 		      csym = csym->common_next;
! 		    }
  
! 		  gcc_assert(cparent->common_next == p);
  
! 		  cparent->common_next = csym->common_next;
  		}
- 	    }
  
  	  /* The derived type is saved in the symtree with the first
  	     letter capitalized; the all lower-case version to the
  	     derived type contains its associated generic function.  */
--- 3168,3216 ----
  
    FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
      {
!       /* Symbol was new. Or was old and just put in common */
!       if ((p->gfc_new
! 	   || (p->attr.in_common && !p->old_symbol->attr.in_common ))
! 	  && p->attr.in_common && p->common_block && p->common_block->head)
  	{
! 	  /* If the symbol was added to any common block, it
! 	     needs to be removed to stop the resolver looking
! 	     for a (possibly) dead symbol.  */
  
! 	  if (p->common_block->head == p && !p->common_next)
! 	    {
! 	      gfc_symtree st, *st0;
! 	      st0 = find_common_symtree (p->ns->common_root,
! 					 p->common_block);
! 	      if (st0)
  		{
! 		  st.name = st0->name;
! 		  gfc_delete_bbt (&p->ns->common_root, &st, compare_symtree);
! 		  free (st0);
  		}
+ 	    }
  
! 	  if (p->common_block->head == p)
! 	    p->common_block->head = p->common_next;
! 	  else
! 	    {
! 	      gfc_symbol *cparent, *csym;
  
! 	      cparent = p->common_block->head;
! 	      csym = cparent->common_next;
  
! 	      while (csym != p)
! 		{
! 		  cparent = csym;
! 		  csym = csym->common_next;
  		}
  
+ 	      gcc_assert(cparent->common_next == p);
+ 	      cparent->common_next = csym->common_next;
+ 	    }
+ 	}
+       if (p->gfc_new)
+ 	{
  	  /* The derived type is saved in the symtree with the first
  	     letter capitalized; the all lower-case version to the
  	     derived type contains its associated generic function.  */
Index: testsuite/gfortran.dg/common_22.f90
===================================================================
*** testsuite/gfortran.dg/common_22.f90	(révision 0)
--- testsuite/gfortran.dg/common_22.f90	(copie de travail)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ !
+ ! PR fortran/59746
+ ! Check that symbols present in common block are properly cleaned up
+ ! upon error.
+ !
+ ! Contributed by Bud Davis  <jmdavis@link.com>
+ 
+       CALL RCCFL (NVE,IR,NU3,VE (1,1,1,I))
+       COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+       COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+ !  the PR only contained the two above.
+ !  success is no segfaults or infinite loops.
+ !  let's check some combinations
+      CALL ABC (INTG)
+      COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+      COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+      CALL DEF (NT1)
+      COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+      COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+      CALL GHI (NRESL)
+      COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+      COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
+      END