From a0909527ea43a796239cd68c7354a3a4447852b7 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 26 Jan 2016 21:57:12 +0000 Subject: [PATCH] [multiple changes] 2016-01-26 Paul Thomas 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 PR fortran/69385 * gfortran.dg/allocate_error_6.f90: New test. From-SVN: r232850 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-expr.c | 18 +++++---- gcc/testsuite/ChangeLog | 7 +++- .../gfortran.dg/allocate_error_6.f90 | 40 +++++++++++++++++++ 4 files changed, 64 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_error_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a137e919fe4..0a55a09d350 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016-01-26 Paul Thomas + + 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 PR other/69006 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 40a971f626d..5031a37a25a 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 3e40014eeb0..a35d29568a8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-01-26 Paul Thomas + + PR fortran/69385 + * gfortran.dg/allocate_error_6.f90: New test. + 2016-01-26 Richard Henderson * 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 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 00000000000..f512bcbd777 --- /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 +! +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