Skip to content

R
riscv-gcc-1
Commit c1525930 by Tobias Burnus Committed by Tobias Burnus
Options

Fix bounds with ALLOCATE with source-expr 

        PR fortran/67125
        * trans-array.c (gfc_array_init_size, gfc_array_allocate):
        Rename argument e3_is_array_constr to e3_has_nodescriptor
        and update comments.
        * trans-stmt.c (gfc_trans_allocate): Also fix lower bound
        to 1 for nonalloc/nonpointer func results/vars besides
        array constructors.

        PR fortran/67125
        * gfortran.dg/allocate_with_source_26.f90: New.

From-SVN: r265212
parent 91ab2a1d
Showing with 101 additions and 14 deletions
gcc/fortran/ChangeLog
2018-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/67125
* trans-array.c (gfc_array_init_size, gfc_array_allocate):
Rename argument e3_is_array_constr to e3_has_nodescriptor
and update comments.
* trans-stmt.c (gfc_trans_allocate): Also fix lower bound
to 1 for nonalloc/nonpointer func results/vars besides
array constructors.
2018-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/87556
* trans-stmt.c (form_team, change_team, sync_team):
Don't ignore argse.pre/argse.post.
......
gcc/fortran/trans-array.c
......@@ -5333,7 +5333,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
stmtblock_t * descriptor_block, tree * overflow,
tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
tree expr3_desc, bool e3_is_array_constr, gfc_expr *expr)
tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr)
{
tree type;
tree tmp;
......@@ -5412,10 +5412,11 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
gfc_init_se (&se, NULL);
if (expr3_desc != NULL_TREE)
{
if (e3_is_array_constr)
/* The lbound of a constant array [] starts at zero, but when
allocating it, the standard expects the array to start at
one. */
if (e3_has_nodescriptor)
/* The lbound of nondescriptor arrays like array constructors,
nonallocatable/nonpointer function results/variables,
start at zero, but when allocating it, the standard expects
the array to start at one. */
se.expr = gfc_index_one_node;
else
se.expr = gfc_conv_descriptor_lbound_get (expr3_desc,
......@@ -5451,12 +5452,13 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
gfc_init_se (&se, NULL);
if (expr3_desc != NULL_TREE)
{
if (e3_is_array_constr)
if (e3_has_nodescriptor)
{
/* The lbound of a constant array [] starts at zero, but when
allocating it, the standard expects the array to start at
one. Therefore fix the upper bound to be
(desc.ubound - desc.lbound)+ 1. */
/* The lbound of nondescriptor arrays like array constructors,
nonallocatable/nonpointer function results/variables,
start at zero, but when allocating it, the standard expects
the array to start at one. Therefore fix the upper bound to be
(desc.ubound - desc.lbound) + 1. */
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (
......@@ -5684,7 +5686,7 @@ bool
gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
tree errlen, tree label_finish, tree expr3_elem_size,
tree *nelems, gfc_expr *expr3, tree e3_arr_desc,
bool e3_is_array_constr)
bool e3_has_nodescriptor)
{
tree tmp;
tree pointer;
......@@ -5813,7 +5815,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
&offset, lower, upper,
&se->pre, &set_descriptor_block, &overflow,
expr3_elem_size, nelems, expr3, e3_arr_desc,
e3_is_array_constr, expr);
e3_has_nodescriptor, expr);
if (dimension)
{
......
gcc/fortran/trans-stmt.c
......@@ -5801,6 +5801,7 @@ gfc_trans_allocate (gfc_code * code)
tree nelems;
bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
bool needs_caf_sync, caf_refs_comp;
bool e3_has_nodescriptor = false;
gfc_symtree *newsym = NULL;
symbol_attribute caf_attr;
gfc_actual_arglist *param_list;
......@@ -6236,6 +6237,17 @@ gfc_trans_allocate (gfc_code * code)
}
else
e3rhs = gfc_copy_expr (code->expr3);
// We need to propagate the bounds of the expr3 for source=/mold=;
// however, for nondescriptor arrays, we use internally a lower bound
// of zero instead of one, which needs to be corrected for the allocate obj
if (e3_is == E3_DESC)
{
symbol_attribute attr = gfc_expr_attr (code->expr3);
if (code->expr3->expr_type == EXPR_ARRAY ||
(!attr.allocatable && !attr.pointer))
e3_has_nodescriptor = true;
}
}
/* Loop over all objects to allocate. */
......@@ -6319,12 +6331,12 @@ gfc_trans_allocate (gfc_code * code)
}
else
tmp = expr3_esize;
if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen,
label_finish, tmp, &nelems,
e3rhs ? e3rhs : code->expr3,
e3_is == E3_DESC ? expr3 : NULL_TREE,
code->expr3 != NULL && e3_is == E3_DESC
&& code->expr3->expr_type == EXPR_ARRAY))
e3_has_nodescriptor))
{
/* A scalar or derived type. First compute the size to
allocate.
......
gcc/testsuite/ChangeLog
2018-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/67125
* gfortran.dg/allocate_with_source_26.f90: New.
2018-10-15 David Malcolm <dmalcolm@redhat.com>
* gcc.dg/missing-header-fixit-3.c: Update expected indentation
......
gcc/testsuite/gfortran.dg/allocate_with_source_26.f90 0 → 100644
! { dg-do run }
!
! Ensure that the lower bound starts with the correct
! value
!
! PR fortran/87580
! PR fortran/67125
!
! Contributed by Antony Lewis and mrestelli
!
program p
implicit none
integer, allocatable :: a(:), b(:), c(:), d(:), e(:)
integer :: vec(6)
vec = [1,2,3,4,5,6]
allocate(a, source=f(3))
allocate(b, source=g(3))
allocate(c, source=h(3))
allocate(d, source=[1,2,3,4,5])
allocate(e, source=vec)
!write(*,*) lbound(a,1), ubound(a,1) ! prints 1 3
!write(*,*) lbound(b,1), ubound(b,1) ! prints 1 3
!write(*,*) lbound(c,1), ubound(c,1) ! prints 3 5
!write(*,*) lbound(d,1), ubound(d,1) ! prints 1 5
!write(*,*) lbound(e,1), ubound(e,1) ! prints 1 6
if (lbound(a,1) /= 1 .or. ubound(a,1) /= 3 &
.or. lbound(b,1) /= 1 .or. ubound(b,1) /= 3 &
.or. lbound(c,1) /= 3 .or. ubound(c,1) /= 5 &
.or. lbound(d,1) /= 1 .or. ubound(d,1) /= 5 &
.or. lbound(e,1) /= 1 .or. ubound(e,1) /= 6) then
call abort()
endif
contains
pure function f(i)
integer, intent(in) :: i
integer :: f(i)
f = 2*i
end function f
pure function g(i) result(r)
integer, value, intent(in) :: i
integer, allocatable :: r(:)
r = [1,2,3]
end function g
pure function h(i) result(r)
integer, value, intent(in) :: i
integer, allocatable :: r(:)
allocate(r(3:5))
r = [1,2,3]
end function h
end program p
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment