This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: PR fortran/18899: ubound() failing for assumed-shape arrays


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]