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

5 files changed, 50 insertions, 4 deletions

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  <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
 	* 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  <richard@codesourcery.com>
 
+	PR fortran/18899
+	* fortran.dg/shape_2.f90: New test.
+
+2005-09-13  Richard Sandiford  <richard@codesourcery.com>
+
 	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