This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: PR fortran/18899: ubound() failing for assumed-shape arrays
- From: Richard Sandiford <richard at codesourcery dot com>
- To: Steven Bosscher <stevenb at suse dot de>
- Cc: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Tue, 13 Sep 2005 08:33:20 +0100
- Subject: Re: PR fortran/18899: ubound() failing for assumed-shape arrays
- References: <87zmqiehza.fsf@talisman.home><200509121208.38635.stevenb@suse.de>
Steven Bosscher <stevenb@suse.de> writes:
> On Monday 12 September 2005 11:46, Richard Sandiford wrote:
>> I think the two cases where we need a lower bound of 1 are:
>>
>> - when referring to a section of b (because lbound() is then
>> defined to be 1 for every dimension)
>>
>> - when the array will be used as a pointer target (because the
>> pointer code assumes this, and because applying lbound() to
>> the pointer should also give 1 for every dimension)
>
> Could you perhaps add test cases for that too, then?
OK, the testcase now checks pointer bounds too. The patch is
otherwise the same as before.
Bootstrapped & regression-tested on i686-pc-linux-gnu. OK to install?
Richard
gcc/fortran/
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.
gcc/testsuite/
PR fortran/18899
* fortran.dg/shape_2.f90: New test.
Index: gcc/fortran/trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.53
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.53 trans-intrinsic.c
*** gcc/fortran/trans-intrinsic.c 9 Aug 2005 17:33:12 -0000 1.53
--- gcc/fortran/trans-intrinsic.c 13 Sep 2005 07:30:57 -0000
*************** gfc_conv_intrinsic_bound (gfc_se * se, g
*** 639,645 ****
gfc_ss *ss;
int i;
- gfc_init_se (&argse, NULL);
arg = expr->value.function.actual;
arg2 = arg->next;
--- 639,644 ----
*************** gfc_conv_intrinsic_bound (gfc_se * se, g
*** 671,677 ****
/* Get a descriptor for the first parameter. */
ss = gfc_walk_expr (arg->expr);
gcc_assert (ss != gfc_ss_terminator);
! argse.want_pointer = 0;
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);
--- 670,676 ----
/* Get a descriptor for the first parameter. */
ss = gfc_walk_expr (arg->expr);
gcc_assert (ss != gfc_ss_terminator);
! 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);
Index: gcc/fortran/trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.61
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.61 trans-array.c
*** gcc/fortran/trans-array.c 13 Sep 2005 07:14:57 -0000 1.61
--- gcc/fortran/trans-array.c 13 Sep 2005 07:30:58 -0000
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 3981,3989 ****
/* Set the new lower bound. */
from = loop.from[dim];
to = loop.to[dim];
! if (!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);
--- 3981,3993 ----
/* Set the new lower bound. */
from = loop.from[dim];
to = loop.to[dim];
!
! /* 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))
{
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 -c /dev/null gcc/testsuite/gfortran.dg/shape_2.f90
*** /dev/null 2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/shape_2.f90 2005-09-13 08:30:37.000000000 +0100
***************
*** 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