FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/18899 ([gfortran] ubound wrongly calculated for passed array)

Browse source 
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
This commit is contained in:
Richard Sandiford 2005-09-13 08:07:15 +00:00 • committed by Richard Sandiford
parent d7f0e25cd0
commit 4fd9a81345
5 changed files with 50 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2005-09-13 Richard Sandiford <richard@codesourcery.com>
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 <richard@codesourcery.com>
PR target/19269

8
gcc/fortran/trans-array.c
View file

@ -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);

3
gcc/fortran/trans-intrinsic.c
View file

@ -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);

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2005-09-13 Richard Sandiford <richard@codesourcery.com>
PR fortran/18899
* fortran.dg/shape_2.f90: New test.
2005-09-13 Richard Sandiford <richard@codesourcery.com>
PR target/19269

30
gcc/testsuite/gfortran.dg/shape_2.f90 Normal file
View file

@ -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