From ec9200dc186d96741a2e2f9fee6a8f291ce1e647 Mon Sep 17 00:00:00 2001 From: rsandifo Date: Tue, 13 Sep 2005 08:07:15 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104219 138bc75d-0d04-0410-961f-82ee72b054a4 --- 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 02f8f3f..9ccd866 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 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 * iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift) (gfc_resolve_pack, gfc_resolve_reshape, gfc_resolve_spread) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a7a1c55..a72a19d 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 f7907ec..d498717 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 a909f30..641f1f2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2005-09-13 Richard Sandiford + PR fortran/18899 + * fortran.dg/shape_2.f90: New test. + +2005-09-13 Richard Sandiford + PR target/19269 * gfortran.dg/char_associated_1.f90, gfortran.dg/char_cshift_1.f90, * gfortran.dg/char_cshift_2.f90, gfortran.dg/char_eoshift_1.f90, diff --git a/gcc/testsuite/gfortran.dg/shape_2.f90 b/gcc/testsuite/gfortran.dg/shape_2.f90 new file mode 100644 index 0000000..a4bde98 --- /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 -- 2.7.4