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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 02f8f3f..9ccd866 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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