]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/47844 (Array stride ignored for pointer-valued function results)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 8 Oct 2011 10:18:51 +0000 (10:18 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 8 Oct 2011 10:18:51 +0000 (10:18 +0000)
2011-10-08  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/47844
* trans-array.c (gfc_conv_array_index_offset): Use descriptor
stride for pointer function results.

2011-10-08  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/47844
* gfortran.dg/pointer_function_result_1.f90 : New test.

From-SVN: r179710

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pointer_function_result_1.f90 [new file with mode: 0644]

index a4e1c5f8c4e82bd23ca873cac8d428360315e4ef..2c09f9aeef62300dafda186bbfad6f2dcdec073e 100644 (file)
@@ -1,3 +1,9 @@
+2011-10-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/47844
+       * trans-array.c (gfc_conv_array_index_offset): Use descriptor
+       stride for pointer function results.
+
 2011-10-07  Mikael Morin  <mikael.morin@sfr.fr>
 
        * trans-array.c (gfc_conv_expr_descriptor): Remove trailing whitespace.
index 79dbafa29f412db76c3bb6b4d82ffa0a7bf6dbd3..b7556704ca19eb4dcf8b0ded067c03355dfb8528 100644 (file)
@@ -2609,6 +2609,18 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
       /* Temporary array or derived type component.  */
       gcc_assert (se->loop);
       index = se->loop->loopvar[se->loop->order[i]];
+
+      /* Pointer functions can have stride[0] different from unity. 
+        Use the stride returned by the function call and stored in
+        the descriptor for the temporary.  */ 
+      if (se->ss && se->ss->type == GFC_SS_FUNCTION
+           && se->ss->expr
+           && se->ss->expr->symtree
+           && se->ss->expr->symtree->n.sym->result
+           && se->ss->expr->symtree->n.sym->result->attr.pointer)
+       stride = gfc_conv_descriptor_stride_get (info->descriptor,
+                                                gfc_rank_cst[dim]);
+
       if (!integer_zerop (info->delta[dim]))
        index = fold_build2_loc (input_location, PLUS_EXPR,
                                 gfc_array_index_type, index, info->delta[dim]);
index ea79b6075fb50c7de5ccbe895a3a503febcfe932..02a8ffd119e837b78a98c68ccf6a1d23e91aa948 100644 (file)
@@ -1,3 +1,8 @@
+2011-10-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/47844
+       * gfortran.dg/pointer_function_result_1.f90 : New test.
+
 2011-10-07  David S. Miller  <davem@davemloft.net>
 
        PR 50655
diff --git a/gcc/testsuite/gfortran.dg/pointer_function_result_1.f90 b/gcc/testsuite/gfortran.dg/pointer_function_result_1.f90
new file mode 100644 (file)
index 0000000..764a666
--- /dev/null
@@ -0,0 +1,28 @@
+! { dg-do run }
+! Test the fix for PR47844, in which the stride in the function result
+! was ignored. Previously, the result was [1,3] at lines 15 and 16.
+!
+! Contributed by KePu  <Kdx1999@gmail.com>
+!
+PROGRAM test_pointer_value
+  IMPLICIT NONE
+  INTEGER, DIMENSION(10), TARGET :: array= [1,3,5,7,9,11,13,15,17,19]
+  INTEGER, dimension(2) :: array_fifth
+  INTEGER, POINTER, DIMENSION(:) :: ptr_array => NULL()
+  INTEGER, POINTER, DIMENSION(:) :: ptr_array_fifth => NULL()
+  ptr_array => array
+  array_fifth = every_fifth (ptr_array)
+  if (any (array_fifth .ne. [1,11])) call abort
+  if (any (every_fifth(ptr_array) .ne. [1,11])) call abort
+CONTAINS
+  FUNCTION every_fifth (ptr_array) RESULT (ptr_fifth)
+    IMPLICIT NONE
+    INTEGER, POINTER, DIMENSION(:) :: ptr_fifth
+    INTEGER, POINTER, DIMENSION(:), INTENT(in) :: ptr_array
+    INTEGER :: low
+    INTEGER :: high
+    low = LBOUND (ptr_array, 1)
+    high = UBOUND (ptr_array, 1)
+    ptr_fifth => ptr_array (low: high: 5) 
+  END FUNCTION every_fifth
+END PROGRAM test_pointer_value