Subversion Repositories openrisc

! { dg-do compile }

! { dg-options "-fcoarray=single" }

!

! PR fortran/40632

!

! CONTIGUOUS compile-time tests

!

! C448: Must be an array with POINTER attribute

type t1

  integer, contiguous :: ca(5) ! { dg-error "Component .ca. at .1. has the CONTIGUOUS" }

end type t1

type t2

  integer, contiguous, allocatable :: cb(:) ! { dg-error "Component .cb. at .1. has the CONTIGUOUS" }

end type t2

type t3

  integer, contiguous, pointer :: cc(:) ! OK

end type t3

type t4

  integer, pointer, contiguous :: cd ! { dg-error "Component .cd. at .1. has the CONTIGUOUS" }

end type t4

end

! C530: Must be an array and (a) a POINTER or (b) assumed shape.

subroutine test(x, y)

  integer, pointer :: x(:)

  integer, intent(in) :: y(:)

  contiguous :: x, y

  integer, contiguous :: a(5) ! { dg-error ".a. at .1. has the CONTIGUOUS attribute" }

  integer, contiguous, allocatable :: b(:) ! { dg-error ".b. at .1. has the CONTIGUOUS attribute" }

  integer, contiguous, pointer :: c(:) ! OK

  integer, pointer, contiguous :: d ! { dg-error ".d. at .1. has the CONTIGUOUS attribute" }

end

! Pointer assignment check:

! If the pointer object has the CONTIGUOUS attribute, the pointer target shall be contiguous.

! Note: This is not compile-time checkable; but F2008, 5.3.7 except in a very few cases.

subroutine ptr_assign()

  integer, pointer, contiguous :: ptr1(:)

  integer, target :: tgt(5)

  ptr1 => tgt

end subroutine

! C1239 (R1223) If an actual argument is a nonpointer array that has the ASYNCHRONOUS or VOLATILE

! attribute but is not simply contiguous (6.5.4), and the corresponding dummy argument has either the

! VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an assumed-shape array

! that does not have the CONTIGUOUS attribute.

subroutine C1239

  type t

    integer :: e(4)

  end type t

  type(t), volatile :: f

  integer, asynchronous :: a(4), b(4)

  integer, volatile :: c(4), d(4)

  call test (a,b,c)      ! OK

  call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }

  call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }

  call test (a,b,f%e)      ! OK

  call test (a,f%e,c)      ! OK

  call test (f%e,b,c)      ! OK

  call test (a,b,f%e(::2)) ! OK

  call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }

  call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }

contains

  subroutine test(u, v, w)

    integer, asynchronous :: u(:), v(*)

    integer, volatile :: w(:)

    contiguous :: u

  end subroutine test

end subroutine C1239

! C1240 (R1223) If an actual argument is an array pointer that has the ASYNCHRONOUS or VOLATILE

! attribute but does not have the CONTIGUOUS attribute, and the corresponding dummy argument has

! either the VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an array pointer

! or an assumed-shape array that does not have the CONTIGUOUS attribute.

subroutine C1240

  type t

    integer,pointer :: e(:)

  end type t

  type(t), volatile :: f

  integer, pointer, asynchronous :: a(:), b(:)

  integer,pointer, volatile :: c(:), d(:)

  call test (a,b,c)      ! { dg-error "array without CONTIGUOUS" }

  call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }

  call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }

  call test (a,b,f%e)      ! { dg-error "array without CONTIGUOUS" }

  call test (a,f%e,c)      ! { dg-error "array without CONTIGUOUS" }

  call test (f%e,b,c)      ! { dg-error "array without CONTIGUOUS" }

  call test (a,b,f%e(::2)) ! { dg-error "array without CONTIGUOUS" }

  call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }

  call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }

  call test2(a,b)

  call test3(a,b)

  call test2(c,d)

  call test3(c,d)

  call test2(f%e,d)

  call test3(c,f%e)

contains

  subroutine test(u, v, w)

    integer, asynchronous :: u(:), v(*)

    integer, volatile :: w(:)

    contiguous :: u

  end subroutine test

  subroutine test2(x,y)

    integer, asynchronous :: x(:)

    integer, volatile :: y(:)

  end subroutine test2

  subroutine test3(x,y)

    integer, pointer, asynchronous :: x(:)

    integer, pointer, volatile :: y(:)

  end subroutine test3

end subroutine C1240

! 12.5.2.7 Pointer dummy variables

! C1241 The actual argument corresponding to a dummy pointer with the CONTIGUOUS attribute shall be

! simply contiguous (6.5.4).

subroutine C1241

  integer, pointer, contiguous :: a(:)

  integer, pointer :: b(:)

  call test(a)

  call test(b) ! { dg-error "must be simply contigous" }

contains

  subroutine test(x)

    integer, pointer, contiguous :: x(:)

  end subroutine test

end subroutine C1241

! 12.5.2.8 Coarray dummy variables

! If the dummy argument is an array coarray that has the CONTIGUOUS attribute or is not of assumed shape,

! the corresponding actual argument shall be simply contiguous

subroutine sect12528(cob)

  integer, save :: coa(6)[*]

  integer :: cob(:)[*]

  call test(coa)

  call test2(coa)

  call test3(coa)

  call test(cob) ! { dg-error "must be simply contiguous" }

  call test2(cob) ! { dg-error "must be simply contiguous" }

  call test3(cob)

contains

  subroutine test(x)

    integer, contiguous :: x(:)[*]

  end subroutine test

  subroutine test2(x)

    integer :: x(*)[*]

  end subroutine test2

  subroutine test3(x)

    integer :: x(:)[*]

  end subroutine test3

end subroutine sect12528

subroutine test34

  implicit none

  integer, volatile,pointer :: a(:,:),i

  call foo(a(2,2:3:2)) ! { dg-error "must be simply contigous" }

contains

  subroutine foo(x)

    integer, pointer, contiguous, volatile :: x(:)

  end subroutine

end subroutine test34