From 4fd9a81345882be70ae24604eb98d3db9ec9f321 Mon Sep 17 00:00:00 2001 From: Richard Sandiford Date: Tue, 13 Sep 2005 08:07:15 +0000 Subject: [PATCH] re PR fortran/18899 ([gfortran] ubound wrongly calculated for passed array) PR fortran/18899 * trans-intrinsic.c (gfc_conv_intrinsic_bound): Move initialization of argse. Remove now-redundant want_pointer assignment. * trans-array.c (gfc_conv_expr_descriptor): When not assigning to a pointer, keep the original bounds of a full array reference. From-SVN: r104219 --- gcc/fortran/ChangeLog | 8 +++++++ gcc/fortran/trans-array.c | 8 +++++-- gcc/fortran/trans-intrinsic.c | 3 +-- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/shape_2.f90 | 30 +++++++++++++++++++++++++++ 5 files changed, 50 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/shape_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 02f8f3fa456..9ccd866fdfd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2005-09-13 Richard Sandiford + + PR fortran/18899 + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Move initialization + of argse. Remove now-redundant want_pointer assignment. + * trans-array.c (gfc_conv_expr_descriptor): When not assigning to + a pointer, keep the original bounds of a full array reference. + 2005-09-13 Richard Sandiford PR target/19269 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a7a1c558d0e..a72a19dcdce 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3981,9 +3981,13 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* Set the new lower bound. */ from = loop.from[dim]; to = loop.to[dim]; - if (!integer_onep (from)) + + /* If we have an array section or are assigning to a pointer, + make sure that the lower bound is 1. References to the full + array should otherwise keep the original bounds. */ + if ((info->ref->u.ar.type != AR_FULL || se->direct_byref) + && !integer_onep (from)) { - /* Make sure the new section starts at 1. */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, gfc_index_one_node, from); to = fold_build2 (PLUS_EXPR, gfc_array_index_type, to, tmp); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index f7907ecd92d..d498717d795 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -639,7 +639,6 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) gfc_ss *ss; int i; - gfc_init_se (&argse, NULL); arg = expr->value.function.actual; arg2 = arg->next; @@ -671,7 +670,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) /* Get a descriptor for the first parameter. */ ss = gfc_walk_expr (arg->expr); gcc_assert (ss != gfc_ss_terminator); - argse.want_pointer = 0; + gfc_init_se (&argse, NULL); gfc_conv_expr_descriptor (&argse, arg->expr, ss); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a909f302345..641f1f2790e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-09-13 Richard Sandiford + + PR fortran/18899 + * fortran.dg/shape_2.f90: New test. + 2005-09-13 Richard Sandiford PR target/19269 diff --git a/gcc/testsuite/gfortran.dg/shape_2.f90 b/gcc/testsuite/gfortran.dg/shape_2.f90 new file mode 100644 index 00000000000..a4bde98ba5f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/shape_2.f90 @@ -0,0 +1,30 @@ +! Check that lbound() and ubound() work correctly for assumed shapes. +! { dg-do run } +program main + integer, dimension (40, 80) :: a = 1 + call test (a) +contains + subroutine test (b) + integer, dimension (11:, -8:), target :: b + integer, dimension (:, :), pointer :: ptr + + if (lbound (b, 1) .ne. 11) call abort + if (ubound (b, 1) .ne. 50) call abort + if (lbound (b, 2) .ne. -8) call abort + if (ubound (b, 2) .ne. 71) call abort + + if (lbound (b (:, :), 1) .ne. 1) call abort + if (ubound (b (:, :), 1) .ne. 40) call abort + if (lbound (b (:, :), 2) .ne. 1) call abort + if (ubound (b (:, :), 2) .ne. 80) call abort + + if (lbound (b (20:30:3, 40), 1) .ne. 1) call abort + if (ubound (b (20:30:3, 40), 1) .ne. 4) call abort + + ptr => b + if (lbound (ptr, 1) .ne. 1) call abort + if (ubound (ptr, 1) .ne. 40) call abort + if (lbound (ptr, 2) .ne. 1) call abort + if (ubound (ptr, 2) .ne. 80) call abort + end subroutine test +end program main