[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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a137e919fe48826446d28dc917f0b6848456473f..0a55a09d350ac7521cf2db17fbb984ef7e5a6b46 100644 (file)
--- 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 40a971f626dea5c25aa2ed695e79f4abf15a8bcc..5031a37a25aecaf85a11b63768ab413ef93fedc7 100644 (file)
--- 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 3e40014eeb0b4f4c3b457a8a7a7c04fc77d31501..a35d29568a8a3b028d46bcfa733e55a4fc7738f2 100644 (file)
--- 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 (file)
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