gcc/testsuite/gfortran.dg/contiguous_1.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single" }
   3 !
   4 ! PR fortran/40632
   5 !
   6 ! CONTIGUOUS compile-time tests
   7 !
   8
   9 ! C448: Must be an array with POINTER attribute
  10 type t1
  11   integer, contiguous :: ca(5) ! { dg-error "Component .ca. at .1. has the CONTIGUOUS" }
  12 end type t1
  13 type t2
  14   integer, contiguous, allocatable :: cb(:) ! { dg-error "Component .cb. at .1. has the CONTIGUOUS" }
  15 end type t2
  16 type t3
  17   integer, contiguous, pointer :: cc(:) ! OK
  18 end type t3
  19 type t4
  20   integer, pointer, contiguous :: cd ! { dg-error "Component .cd. at .1. has the CONTIGUOUS" }
  21 end type t4
  22 end
  23
  24 ! C530: Must be an array and (a) a POINTER or (b) assumed shape.
  25 subroutine test(x, y)
  26   integer, pointer :: x(:)
  27   integer, intent(in) :: y(:)
  28   contiguous :: x, y
  29
  30   integer, contiguous :: a(5) ! { dg-error ".a. at .1. has the CONTIGUOUS attribute" }
  31   integer, contiguous, allocatable :: b(:) ! { dg-error ".b. at .1. has the CONTIGUOUS attribute" }
  32   integer, contiguous, pointer :: c(:) ! OK
  33   integer, pointer, contiguous :: d ! { dg-error ".d. at .1. has the CONTIGUOUS attribute" }
  34 end
  35
  36 ! Pointer assignment check:
  37 ! If the pointer object has the CONTIGUOUS attribute, the pointer target shall be contiguous.
  38 ! Note: This is not compile-time checkable; but F2008, 5.3.7 except in a very few cases.
  39 subroutine ptr_assign()
  40   integer, pointer, contiguous :: ptr1(:)
  41   integer, target :: tgt(5)
  42   ptr1 => tgt
  43 end subroutine
  44
  45
  46 ! C1239 (R1223) If an actual argument is a nonpointer array that has the ASYNCHRONOUS or VOLATILE
  47 ! attribute but is not simply contiguous (6.5.4), and the corresponding dummy argument has either the
  48 ! VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an assumed-shape array
  49 ! that does not have the CONTIGUOUS attribute.
  50
  51 subroutine C1239
  52   type t
  53     integer :: e(4)
  54   end type t
  55   type(t), volatile :: f
  56   integer, asynchronous :: a(4), b(4)
  57   integer, volatile :: c(4), d(4)
  58   call test (a,b,c)      ! OK
  59   call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
  60   call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
  61
  62   call test (a,b,f%e)      ! OK
  63   call test (a,f%e,c)      ! OK
  64   call test (f%e,b,c)      ! OK
  65   call test (a,b,f%e(::2)) ! OK
  66   call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
  67   call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
  68 contains
  69   subroutine test(u, v, w)
  70     integer, asynchronous :: u(:), v(*)
  71     integer, volatile :: w(:)
  72     contiguous :: u
  73   end subroutine test
  74 end subroutine C1239
  75
  76
  77 ! C1240 (R1223) If an actual argument is an array pointer that has the ASYNCHRONOUS or VOLATILE
  78 ! attribute but does not have the CONTIGUOUS attribute, and the corresponding dummy argument has
  79 ! either the VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an array pointer
  80 ! or an assumed-shape array that does not have the CONTIGUOUS attribute.
  81
  82 subroutine C1240
  83   type t
  84     integer,pointer :: e(:)
  85   end type t
  86   type(t), volatile :: f
  87   integer, pointer, asynchronous :: a(:), b(:)
  88   integer,pointer, volatile :: c(:), d(:)
  89   call test (a,b,c)      ! { dg-error "array without CONTIGUOUS" }
  90   call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
  91   call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
  92
  93   call test (a,b,f%e)      ! { dg-error "array without CONTIGUOUS" }
  94   call test (a,f%e,c)      ! { dg-error "array without CONTIGUOUS" }
  95   call test (f%e,b,c)      ! { dg-error "array without CONTIGUOUS" }
  96   call test (a,b,f%e(::2)) ! { dg-error "array without CONTIGUOUS" }
  97   call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
  98   call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
  99
 100   call test2(a,b)
 101   call test3(a,b)
 102   call test2(c,d)
 103   call test3(c,d)
 104   call test2(f%e,d)
 105   call test3(c,f%e)
 106 contains
 107   subroutine test(u, v, w)
 108     integer, asynchronous :: u(:), v(*)
 109     integer, volatile :: w(:)
 110     contiguous :: u
 111   end subroutine test
 112   subroutine test2(x,y)
 113     integer, asynchronous :: x(:)
 114     integer, volatile :: y(:)
 115   end subroutine test2
 116   subroutine test3(x,y)
 117     integer, pointer, asynchronous :: x(:)
 118     integer, pointer, volatile :: y(:)
 119   end subroutine test3
 120 end subroutine C1240
 121
 122
 123
 124 ! 12.5.2.7 Pointer dummy variables
 125 ! C1241 The actual argument corresponding to a dummy pointer with the CONTIGUOUS attribute shall be
 126 ! simply contiguous (6.5.4).
 127
 128 subroutine C1241
 129   integer, pointer, contiguous :: a(:)
 130   integer, pointer :: b(:)
 131   call test(a)
 132   call test(b) ! { dg-error "must be simply contigous" }
 133 contains
 134   subroutine test(x)
 135     integer, pointer, contiguous :: x(:)
 136   end subroutine test
 137 end subroutine C1241
 138
 139
 140 ! 12.5.2.8 Coarray dummy variables
 141 ! If the dummy argument is an array coarray that has the CONTIGUOUS attribute or is not of assumed shape,
 142 ! the corresponding actual argument shall be simply contiguous
 143
 144 subroutine sect12528(cob)
 145   integer, save :: coa(6)[*]
 146   integer :: cob(:)[*]
 147
 148   call test(coa)
 149   call test2(coa)
 150   call test3(coa)
 151
 152   call test(cob) ! { dg-error "must be simply contiguous" }
 153   call test2(cob) ! { dg-error "must be simply contiguous" }
 154   call test3(cob)
 155 contains
 156   subroutine test(x)
 157     integer, contiguous :: x(:)[*]
 158   end subroutine test
 159   subroutine test2(x)
 160     integer :: x(*)[*]
 161   end subroutine test2
 162   subroutine test3(x)
 163     integer :: x(:)[*]
 164   end subroutine test3
 165 end subroutine sect12528
 166
 167
 168
 169 subroutine test34
 170   implicit none
 171   integer, volatile,pointer :: a(:,:),i
 172   call foo(a(2,2:3:2)) ! { dg-error "must be simply contigous" }
 173 contains
 174   subroutine foo(x)
 175     integer, pointer, contiguous, volatile :: x(:)
 176   end subroutine
 177 end subroutine test34