Subversion Repositories openrisc

! { dg-do run }

! Test the fix for PRs29396, 29606, 30625 and 30871, in which pointers

! to arrays with subreferences did not work.

!

  call pr29396

  call pr29606

  call pr30625

  call pr30871

contains

  subroutine pr29396

! Contributed by Francois-Xavier Coudert 

    CHARACTER(LEN=2), DIMENSION(:), POINTER :: a

    CHARACTER(LEN=4), DIMENSION(3), TARGET :: b

    b=(/"bbbb","bbbb","bbbb"/)

    a=>b(:)(2:3)

    a="aa"

    IF (ANY(b.NE.(/"baab","baab","baab"/))) CALL ABORT()

  END subroutine

  subroutine pr29606

! Contributed by Daniel Franke 

    TYPE foo

      INTEGER :: value

    END TYPE

    TYPE foo_array

      TYPE(foo), DIMENSION(:), POINTER :: array

    END TYPE

    TYPE(foo_array)                :: array_holder

    INTEGER, DIMENSION(:), POINTER :: array_ptr

    ALLOCATE( array_holder%array(3) )

    array_holder%array = (/ foo(1), foo(2), foo(3) /)

    array_ptr => array_holder%array%value

    if (any (array_ptr .ne. (/1,2,3/))) call abort ()

  END subroutine

  subroutine pr30625

! Contributed by Paul Thomas 

    type :: a

      real :: r = 3.14159

      integer :: i = 42

    end type a

    type(a), target :: dt(2)

    integer, pointer :: ip(:)

    ip => dt%i

    if (any (ip .ne. 42)) call abort ()

  end subroutine

  subroutine pr30871

! Contributed by Joost VandeVondele 

    TYPE data

      CHARACTER(LEN=3) :: A

    END TYPE

    TYPE(data), DIMENSION(10), TARGET :: Z

    CHARACTER(LEN=1), DIMENSION(:), POINTER :: ptr

    Z(:)%A="123"

    ptr=>Z(:)%A(2:2)

    if (any (ptr .ne. "2")) call abort ()

  END subroutine

end