view gcc/testsuite/gfortran.dg/associate_24.f90 @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children
line wrap: on
line source

! { dg-do run }
!
! From posting by Spectrum to clf on thread entitled "Bounds for array pointer dummy argument".
!
PROGRAM X
    implicit none
    TYPE T
        INTEGER :: I
    END TYPE T
    TYPE(T), TARGET :: T1( 0:3 )

    associate( P => T1 % I )
        call check (lbound (P, 1), ubound (P, 1) ,1 , 4)
    endassociate

    associate( P2 => T1(:) % I )
        call check (lbound (P2, 1), ubound (P2, 1) ,1 , 4)
    endassociate

    associate( Q => T1 )
        call check (lbound (Q, 1), ubound (Q, 1) ,0 , 3)
    endassociate

    associate( Q2 => T1(:) )
        call check (lbound (Q2, 1), ubound (Q2, 1) ,1 , 4)
    endassociate
contains
    subroutine check (lbnd, ubnd, lower, upper)
      integer :: lbnd, ubnd, lower, upper
      if (lbnd .ne. lower) STOP 1
      if (ubnd .ne. upper) STOP 2
    end subroutine
END PROGRAM X