[Patch, fortran] PR69385 - [6 regression] ICE on valid with -fcheck=mem

[Paul Richard Thomas]

Dear All,

The initial report concerns initialization assignments that should be
excluded from the check for assignment of scalars to unallocated
arrays. This part is so trivial that it does not require a test. On
the other hand, the block that implemented the check was plain and
simple wrong and the rest of the patch corrects this. It is commented
such as to be fully comprehensible.

Bootstrapped and regtested on FC21/x86_64 - OK for trunk and for
5-branch when all the wrinkles (PR69422 and 69423) are sorted out?

Cheers

Paul

2016-01-25  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/69385
    * trans-expr.c (gfc_trans_assignment_1): Exclude initialization
    assignments from check on assignment of scalars to unassigned
    arrays and correct wrong code within the corresponding block.

2015-01-25  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/69385
    * gfortran.dg/allocate_error_6.f90: New test.
-------------- next part --------------
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 232800)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 9286,9291 ****
--- 9286,9292 ----
      {
        gfc_conv_expr (&lse, expr1);
        if (gfc_option.rtcheck & GFC_RTCHECK_MEM
+ 	  && !init_flag
  	  && gfc_expr_attr (expr1).allocatable
  	  && expr1->rank
  	  && !expr2->rank)
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 9293,9306 ****
  	  tree cond;
  	  const char* msg;
  
! 	  tmp = expr1->symtree->n.sym->backend_decl;
! 	  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
! 	    tmp = build_fold_indirect_ref_loc (input_location, tmp);
  
! 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
! 	    tmp = gfc_conv_descriptor_data_get (tmp);
! 	  else
! 	    tmp = TREE_OPERAND (lse.expr, 0);
  
  	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
  				  tmp, build_int_cst (TREE_TYPE (tmp), 0));
--- 9294,9310 ----
  	  tree cond;
  	  const char* msg;
  
! 	  /* We should only get array references here.  */
! 	  gcc_assert (TREE_CODE (lse.expr) == POINTER_PLUS_EXPR
! 		      || TREE_CODE (lse.expr) == ARRAY_REF);
  
! 	  /* 'tmp' is either the pointer to the array(POINTER_PLUS_EXPR)
! 	     or the array itself(ARRAY_REF).  */
! 	  tmp = TREE_OPERAND (lse.expr, 0);
! 
! 	  /* Provide the address of the array.  */
! 	  if (TREE_CODE (lse.expr) == ARRAY_REF)
! 	    tmp = gfc_build_addr_expr (NULL_TREE, tmp);
  
  	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
  				  tmp, build_int_cst (TREE_TYPE (tmp), 0));
Index: gcc/testsuite/gfortran.dg/allocate_error_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocate_error_6.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/allocate_error_6.f90	(working copy)
***************
*** 0 ****
--- 1,40 ----
+ ! { dg-do run }
+ ! { dg-additional-options "-fcheck=mem" }
+ ! { dg-shouldfail "Fortran runtime error: Assignment of scalar to unallocated array" }
+ !
+ ! This omission was encountered in the course of fixing PR54070. Whilst this is a
+ ! very specific case, others such as allocatable components have been tested.
+ !
+ ! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+ !
+ function g(a) result (res)
+   real :: a
+   real,allocatable :: res(:)
+   res = a  ! Since 'res' is not allocated, a runtime error should occur.
+ end function
+ 
+   interface
+     function g(a) result(res)
+       real :: a
+       real,allocatable :: res(:)
+     end function
+   end interface
+ !  print *, g(2.0)
+ !  call foo
+   call foofoo
+ contains
+   subroutine foo
+     type bar
+       real, allocatable, dimension(:) :: r
+     end type
+     type (bar) :: foobar
+     foobar%r = 1.0
+   end subroutine
+   subroutine foofoo
+     type barfoo
+       character(:), allocatable, dimension(:) :: c
+     end type
+     type (barfoo) :: foobarfoo
+     foobarfoo%c = "1.0"
+   end subroutine
+ end