[multiple changes]

2016-01-26  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-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/69385
	* gfortran.dg/allocate_error_6.f90: New test.

From-SVN: r232850

4 files changed, 64 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a137e91..0a55a09 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-01-26  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.
+
 2016-01-26  David Malcolm  <dmalcolm@redhat.com>
 
 	PR other/69006
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 40a971f..5031a37 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9286,6 +9286,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
     {
       gfc_conv_expr (&lse, expr1);
       if (gfc_option.rtcheck & GFC_RTCHECK_MEM
+	  && !init_flag
 	  && gfc_expr_attr (expr1).allocatable
 	  && expr1->rank
 	  && !expr2->rank)
@@ -9293,14 +9294,17 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 	  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);
+	  /* We should only get array references here.  */
+	  gcc_assert (TREE_CODE (lse.expr) == POINTER_PLUS_EXPR
+		      || TREE_CODE (lse.expr) == ARRAY_REF);
 
-	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
-	    tmp = gfc_conv_descriptor_data_get (tmp);
-	  else
-	    tmp = TREE_OPERAND (lse.expr, 0);
+	  /* '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));
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3e40014..a35d295 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/69385
+	* gfortran.dg/allocate_error_6.f90: New test.
+
 2016-01-26  Richard Henderson  <rth@redhat.com>
 
 	* gcc.dg/tm/pr60908.c: New test.
@@ -140,7 +145,7 @@
 	PR fortran/68442
 	* gfortran.dg/interface_38.f90: New test.
 	* gfortran.dg/interface_39.f90: New test.
-	
+
 2016-01-24  Patrick Palka  <ppalka@gcc.gnu.org>
 
 	Revert:
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_6.f90 b/gcc/testsuite/gfortran.dg/allocate_error_6.f90
new file mode 100644
index 0000000..f512bcb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_6.f90
@@ -0,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