gcc/testsuite/gfortran.dg/coarray_7.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fmax-errors=1000 -fcoarray=single" }
   3 !
   4 ! PR fortran/18918
   5 !
   6 ! Coarray expressions.
   7 !
   8 program test
   9   implicit none
  10   type t3
  11     integer, allocatable :: a
  12   end type t3
  13   type t4
  14     type(t3) :: xt3
  15   end type t4
  16   type t
  17     integer, pointer :: ptr
  18     integer, allocatable :: alloc(:)
  19   end type t
  20   type(t), target :: i[*]
  21   type(t), allocatable :: ca[:]
  22   type(t4), target :: tt4[*]
  23   type(t4), allocatable :: ca2[:]
  24   integer, volatile :: volat[*]
  25   integer, asynchronous :: async[*]
  26   integer :: caf1[1,*], caf2[*]
  27   allocate(i%ptr)
  28   call foo(i%ptr)
  29   call foo(i[1]%ptr) ! { dg-error "Coindexed actual argument at .1. to pointer dummy" }
  30   call bar(i%ptr)
  31   call bar(i[1]%ptr) ! OK, value of ptr target
  32   call bar(i[1]%alloc(1)) ! OK
  33   call typeDummy(i) ! OK
  34   call typeDummy(i[1]) ! { dg-error "with ultimate pointer component" }
  35   call typeDummy2(ca) ! OK
  36   call typeDummy2(ca[1]) ! { dg-error "with ultimate pointer component" }
  37   call typeDummy3(tt4%xt3) ! OK
  38   call typeDummy3(tt4[1]%xt3) ! { dg-error "requires either VALUE or INTENT.IN." }
  39   call typeDummy4(ca2) ! OK
  40   call typeDummy4(ca2[1]) ! { dg-error "requires INTENT.IN." }
  41 ! Note: Checking an VOLATILE dummy is not possible as volatile + intent(in)
  42 ! is not possible
  43
  44   call asyn(volat)
  45   call asyn(async)
  46   call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
  47   call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
  48
  49   call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays
  50   call coarray(caf2)
  51   call coarray(caf2[1]) ! { dg-error "must be a coarray" }
  52   call ups(i)
  53   call ups1(i[1]) ! { dg-error "with ultimate pointer component" }
  54   call ups2(i%ptr)
  55   call ups3(i[1]%ptr) ! OK - passes target not pointer
  56 contains
  57   subroutine asyn(a)
  58     integer, intent(in), asynchronous :: a
  59   end subroutine asyn
  60   subroutine bar(a)
  61     integer :: a
  62   end subroutine bar
  63   subroutine foo(a)
  64     integer, pointer :: a
  65   end subroutine foo
  66   subroutine coarray(a)
  67     integer :: a[*]
  68   end subroutine coarray
  69   subroutine typeDummy(a)
  70     type(t) :: a
  71   end subroutine typeDummy
  72   subroutine typeDummy2(a)
  73     type(t),allocatable :: a
  74   end subroutine typeDummy2
  75   subroutine typeDummy3(a)
  76     type(t3) :: a
  77   end subroutine typeDummy3
  78   subroutine typeDummy4(a)
  79     type(t4), allocatable :: a
  80   end subroutine typeDummy4
  81 end program test
  82
  83
  84 subroutine alloc()
  85 type t
  86   integer, allocatable :: a(:)
  87 end type t
  88 type(t), save :: a[*]
  89 type(t), allocatable :: b(:)[:], C[:]
  90
  91 allocate(b(1)) ! { dg-error "Coarray specification" }
  92 allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
  93 allocate(c[*]) ! OK
  94 allocate(a%a(5)) ! OK
  95 end subroutine alloc
  96
  97
  98 subroutine dataPtr()
  99   integer, save, target :: a[*]
 100   data a/5/ ! OK
 101   data a[1]/5/ ! { dg-error "cannot have a coindex" }
 102   type t
 103   integer, pointer :: p
 104   end type t
 105   type(t), save :: x[*]
 106
 107   type t2
 108     integer :: a(1)
 109   end type t2
 110   type(t2) y
 111   data y%a/4/
 112
 113
 114    x[1]%p => a  ! { dg-error "shall not have a coindex" }
 115    x%p => a[1]  ! { dg-error "shall not have a coindex" }
 116 end subroutine dataPtr
 117
 118
 119 subroutine test3()
 120 implicit none
 121 type t
 122   integer :: a(1)
 123 end type t
 124 type(t), save :: x[*]
 125 data x%a/4/
 126
 127   integer, save :: y(1)[*] !(1)
 128   call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
 129 contains
 130   subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
 131     integer :: a(:)[:]
 132   end subroutine sub
 133 end subroutine test3
 134
 135
 136 subroutine test4()
 137   integer, save :: i[*]
 138   integer :: j
 139   call foo(i)
 140   call foo(j) ! { dg-error "must be a coarray" }
 141 contains
 142   subroutine foo(a)
 143     integer :: a[*]
 144   end subroutine foo
 145 end subroutine test4
 146
 147
 148 subroutine allocateTest()
 149   implicit none
 150   real, allocatable, codimension[:,:] :: a,b,c
 151   integer :: n, q
 152   n = 1
 153   q = 1
 154   allocate(a[q,*]) ! OK
 155   allocate(b[q,*]) ! OK
 156   allocate(c[q,*]) ! OK
 157 end subroutine allocateTest
 158
 159
 160 subroutine testAlloc4()
 161   implicit none
 162   type co_double_3
 163     double precision, allocatable :: array(:)
 164   end type co_double_3
 165   type(co_double_3),save, codimension[*] :: work
 166   allocate(work%array(1))
 167   print *, size(work%array)
 168 end subroutine testAlloc4
 169
 170 subroutine test5()
 171   implicit none
 172   integer, save :: i[*]
 173   print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
 174 end subroutine test5
 175