[fortran] PR91588 - ICE in check_inquiry, at fortran/expr.c:2673
diff mbox series

Message ID CAGkQGiJQBXrG01CJU7KBUivWm7+Hv--Z_xT7wUfn=-RgyGbrSw@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR91588 - ICE in check_inquiry, at fortran/expr.c:2673
Related show

Commit Message

Paul Richard Thomas Sept. 15, 2019, 11:40 a.m. UTC
The attached bootstraps and regtests on FC30/x86_64 - OK for trunk?

It strikes me that this should be backported since the bug is rather
fundamental and ispresent all the way back to version 4.8. An obvious
question is how far back? To 8-branch?

Cheers

Paul

2019-09-15  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/91588
    * expr.c (check_inquiry): Remove extended component refs by
    using symbol pointers. If a function argument is an associate
    variable with a constant target, copy the target expression in
    place of the argument expression. Check that the charlen is not
    NULL before using the string length.
    (gfc_check_assign): Remove extraneous space.

2019-09-15  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/91588
    * gfortran.dg/associate_49.f90 : New test.

Comments

Steve Kargl Sept. 15, 2019, 2:40 p.m. UTC | #1
On Sun, Sep 15, 2019 at 12:40:02PM +0100, Paul Richard Thomas wrote:
> The attached bootstraps and regtests on FC30/x86_64 - OK for trunk?
> 
> It strikes me that this should be backported since the bug is rather
> fundamental and ispresent all the way back to version 4.8. An obvious
> question is how far back? To 8-branch?
> 

OK.  If the patch applies cleanly, go back to 8-branch.

Patch
diff mbox series

Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c	(revision 275695)
--- gcc/fortran/expr.c	(working copy)
*************** check_inquiry (gfc_expr *e, int not_rest
*** 2610,2615 ****
--- 2610,2617 ----
  
    int i = 0;
    gfc_actual_arglist *ap;
+   gfc_symbol *sym;
+   gfc_symbol *asym;
  
    if (!e->value.function.isym
        || !e->value.function.isym->inquiry)
*************** check_inquiry (gfc_expr *e, int not_rest
*** 2619,2638 ****
    if (e->symtree == NULL)
      return MATCH_NO;
  
!   if (e->symtree->n.sym->from_intmod)
      {
!       if (e->symtree->n.sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
! 	  && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS
! 	  && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION)
  	return MATCH_NO;
  
!       if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING
! 	  && e->symtree->n.sym->intmod_sym_id != ISOCBINDING_C_SIZEOF)
  	return MATCH_NO;
      }
    else
      {
!       name = e->symtree->n.sym->name;
  
        functions = inquiry_func_gnu;
        if (gfc_option.warn_std & GFC_STD_F2003)
--- 2621,2642 ----
    if (e->symtree == NULL)
      return MATCH_NO;
  
!   sym = e->symtree->n.sym;
! 
!   if (sym->from_intmod)
      {
!       if (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
! 	  && sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS
! 	  && sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION)
  	return MATCH_NO;
  
!       if (sym->from_intmod == INTMOD_ISO_C_BINDING
! 	  && sym->intmod_sym_id != ISOCBINDING_C_SIZEOF)
  	return MATCH_NO;
      }
    else
      {
!       name = sym->name;
  
        functions = inquiry_func_gnu;
        if (gfc_option.warn_std & GFC_STD_F2003)
*************** check_inquiry (gfc_expr *e, int not_rest
*** 2657,2697 ****
        if (!ap->expr)
  	continue;
  
        if (ap->expr->ts.type == BT_UNKNOWN)
  	{
! 	  if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN
! 	      && !gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns))
  	    return MATCH_NO;
  
! 	  ap->expr->ts = ap->expr->symtree->n.sym->ts;
  	}
  
! 	/* Assumed character length will not reduce to a constant expression
! 	   with LEN, as required by the standard.  */
! 	if (i == 5 && not_restricted && ap->expr->symtree
! 	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
! 	    && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
! 		|| ap->expr->symtree->n.sym->ts.deferred))
! 	  {
! 	    gfc_error ("Assumed or deferred character length variable %qs "
! 			"in constant expression at %L",
! 			ap->expr->symtree->n.sym->name,
! 			&ap->expr->where);
! 	      return MATCH_ERROR;
! 	  }
! 	else if (not_restricted && !gfc_check_init_expr (ap->expr))
! 	  return MATCH_ERROR;
  
! 	if (not_restricted == 0
! 	      && ap->expr->expr_type != EXPR_VARIABLE
! 	      && !check_restricted (ap->expr))
  	  return MATCH_ERROR;
  
! 	if (not_restricted == 0
! 	    && ap->expr->expr_type == EXPR_VARIABLE
! 	    && ap->expr->symtree->n.sym->attr.dummy
! 	    && ap->expr->symtree->n.sym->attr.optional)
! 	  return MATCH_NO;
      }
  
    return MATCH_YES;
--- 2661,2708 ----
        if (!ap->expr)
  	continue;
  
+       asym = ap->expr->symtree ? ap->expr->symtree->n.sym : NULL;
+ 
        if (ap->expr->ts.type == BT_UNKNOWN)
  	{
! 	  if (asym && asym->ts.type == BT_UNKNOWN
! 	      && !gfc_set_default_type (asym, 0, gfc_current_ns))
  	    return MATCH_NO;
  
! 	  ap->expr->ts = asym->ts;
  	}
  
!       if (asym && asym->assoc && asym->assoc->target
! 	  && asym->assoc->target->expr_type == EXPR_CONSTANT)
! 	{
! 	  gfc_free_expr (ap->expr);
! 	  ap->expr = gfc_copy_expr (asym->assoc->target);
! 	}
  
!       /* Assumed character length will not reduce to a constant expression
! 	 with LEN, as required by the standard.  */
!       if (i == 5 && not_restricted && asym
! 	  && asym->ts.type == BT_CHARACTER
! 	  && ((asym->ts.u.cl && asym->ts.u.cl->length == NULL)
! 	      || asym->ts.deferred))
! 	{
! 	  gfc_error ("Assumed or deferred character length variable %qs "
! 		     "in constant expression at %L",
! 		      asym->name, &ap->expr->where);
  	  return MATCH_ERROR;
+ 	}
+       else if (not_restricted && !gfc_check_init_expr (ap->expr))
+ 	return MATCH_ERROR;
  
!       if (not_restricted == 0
! 	  && ap->expr->expr_type != EXPR_VARIABLE
! 	  && !check_restricted (ap->expr))
! 	return MATCH_ERROR;
! 
!       if (not_restricted == 0
! 	  && ap->expr->expr_type == EXPR_VARIABLE
! 	  && asym->attr.dummy && asym->attr.optional)
! 	return MATCH_NO;
      }
  
    return MATCH_YES;
*************** gfc_check_assign (gfc_expr *lvalue, gfc_
*** 3683,3689 ****
  
        gfc_error ("BOZ literal constant near %L cannot be assigned to a "
  		 "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts));
!  
        return false;
      }
  
--- 3694,3700 ----
  
        gfc_error ("BOZ literal constant near %L cannot be assigned to a "
  		 "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts));
! 
        return false;
      }
  
Index: gcc/testsuite/gfortran.dg/associate_49.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_49.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/associate_49.f90	(working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR91588, in which the declaration of 'a' caused
+ ! an ICE.
+ !
+ ! Contributed by Gerhardt Steinmetz  <gscfq@t-online.de>
+ !
+ program p
+    character(4), parameter :: parm = '7890'
+    associate (z => '1234')
+       block
+          integer(len(z)) :: a
+          if (kind(a) .ne. 4) stop 1
+       end block
+    end associate
+    associate (z => '123')
+       block
+          integer(len(z)+1) :: a
+          if (kind(a) .ne. 4) stop 2
+       end block
+    end associate
+    associate (z => 1_8)
+       block
+          integer(kind(z)) :: a
+          if (kind(a) .ne. 8) stop 3
+       end block
+    end associate
+    associate (z => parm)
+       block
+          integer(len(z)) :: a
+          if (kind(a) .ne. 4) stop 4
+       end block
+    end associate
+ end