[Bug fortran/69385] [6 regression] ICE on valid with -fcheck=mem

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=69385

--- Comment #11 from Paul Thomas <pault at gcc dot gnu.org> ---
Changing the entire block to:
    {
      gfc_conv_expr (&lse, expr1);
      if (gfc_option.rtcheck & GFC_RTCHECK_MEM
          && !init_flag
          && gfc_expr_attr (expr1).allocatable
          && expr1->rank
          && !expr2->rank)
        {
          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));
          msg = _("Assignment of scalar to unallocated array");
          gfc_trans_runtime_check (true, false, cond, &loop.pre,
                                   &expr1->where, msg);
        }
    }

fixes Martin's problem and makes the following work correctly:

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

If you want to wrap it up and submit it, please do so. Otherwise, I will attend
to it on Sunday.

For some reason that I cannot for the life of me understand, my svn+ssh
connection from my laptop is failing because of some problem with my public
keys. This crept in a couple of weeks ago but hasn't affected my workstations.
The consequence is that I haven't been able to update my tree and cannot
therefore take the specific diff.

****sigh****

Paul