OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [pointer_function_result_1.f90] - Blame information for rev 715

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Test the fix for PR47844, in which the stride in the function result
3
! was ignored. Previously, the result was [1,3] at lines 15 and 16.
4
!
5
! Contributed by KePu  
6
!
7
PROGRAM test_pointer_value
8
  IMPLICIT NONE
9
  INTEGER, DIMENSION(10), TARGET :: array= [1,3,5,7,9,11,13,15,17,19]
10
  INTEGER, dimension(2) :: array_fifth
11
  INTEGER, POINTER, DIMENSION(:) :: ptr_array => NULL()
12
  INTEGER, POINTER, DIMENSION(:) :: ptr_array_fifth => NULL()
13
  ptr_array => array
14
  array_fifth = every_fifth (ptr_array)
15
  if (any (array_fifth .ne. [1,11])) call abort
16
  if (any (every_fifth(ptr_array) .ne. [1,11])) call abort
17
CONTAINS
18
  FUNCTION every_fifth (ptr_array) RESULT (ptr_fifth)
19
    IMPLICIT NONE
20
    INTEGER, POINTER, DIMENSION(:) :: ptr_fifth
21
    INTEGER, POINTER, DIMENSION(:), INTENT(in) :: ptr_array
22
    INTEGER :: low
23
    INTEGER :: high
24
    low = LBOUND (ptr_array, 1)
25
    high = UBOUND (ptr_array, 1)
26
    ptr_fifth => ptr_array (low: high: 5)
27
  END FUNCTION every_fifth
28
END PROGRAM test_pointer_value

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.