gcc/testsuite/gfortran.dg/coarray_lock_3.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single" }
   3 !
   4 !
   5 ! LOCK/LOCK_TYPE checks
   6 !
   7 subroutine extends()
   8 use iso_fortran_env
   9 type t
  10 end type t
  11 type, extends(t) :: t2 ! { dg-error "coarray component, parent type .t. shall also have one" }
  12   type(lock_type), allocatable :: c(:)[:]
  13 end type t2
  14 end subroutine extends
  15
  16 module m
  17   use iso_fortran_env
  18
  19   type t
  20     type(lock_type), allocatable :: x(:)[:]
  21   end type t
  22 end module m
  23
  24 module m2
  25   use iso_fortran_env
  26   type t2
  27     type(lock_type), allocatable :: x ! { dg-error "Allocatable component x at .1. of type LOCK_TYPE must have a codimension" }
  28   end type t2
  29 end module m2
  30
  31 module m3
  32   use iso_fortran_env
  33   type t3
  34     type(lock_type) :: x ! OK
  35   end type t3
  36 end module m3
  37
  38 subroutine sub(x)
  39   use iso_fortran_env
  40   type(lock_type), intent(out) :: x[*] ! OK
  41 end subroutine sub
  42
  43 subroutine sub1(x) ! { dg-error "is INTENT.OUT. and can thus not be an allocatable coarray or have coarray components" }
  44   use iso_fortran_env
  45   type(lock_type), allocatable, intent(out) :: x(:)[:]
  46 end subroutine sub1
  47
  48 subroutine sub2(x) ! { dg-error "is INTENT.OUT. and can thus not be an allocatable coarray or have coarray components" }
  49   use m
  50   type(t), intent(out) :: x
  51 end subroutine sub2
  52
  53 subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, nonallocatable scalar" }
  54   use m
  55   type(t), intent(inout) :: x[*]
  56 end subroutine sub3
  57
  58 subroutine sub4(x)
  59   use m3
  60   type(t3), intent(inout) :: x[*] ! OK
  61 end subroutine sub4
  62
  63 subroutine lock_test
  64   use iso_fortran_env
  65   type t
  66   end type t
  67   type(lock_type) :: lock ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
  68 end subroutine lock_test
  69
  70 subroutine lock_test2
  71   use iso_fortran_env
  72   implicit none
  73   type t
  74   end type t
  75   type(t) :: x
  76   type(lock_type), save :: lock[*],lock2(2)[*]
  77   lock(t) ! { dg-error "Syntax error in LOCK statement" }
  78   lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" }
  79   lock(lock)
  80   lock(lock2(1))
  81   lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" }
  82   lock(lock[1]) ! OK
  83 end subroutine lock_test2
  84
  85
  86 subroutine lock_test3
  87   use iso_fortran_env
  88   type(lock_type), save :: a[*], b[*]
  89   a = b ! { dg-error "LOCK_TYPE in variable definition context" }
  90   b = lock_type() ! { dg-error "LOCK_TYPE in variable definition context" }
  91   print *, a ! { dg-error "cannot have PRIVATE components" }
  92 end subroutine lock_test3
  93
  94
  95 subroutine lock_test4
  96   use iso_fortran_env
  97   type(lock_type), allocatable :: A(:)[:]
  98   logical :: ob
  99   allocate(A(1)[*])
 100   lock(A(1), acquired_lock=ob)
 101   unlock(A(1))
 102   deallocate(A)
 103 end subroutine lock_test4
 104
 105
 106 subroutine argument_check()
 107   use iso_fortran_env
 108   type(lock_type), SAVE :: ll[*]
 109   call no_interface(ll) ! { dg-error "Actual argument of LOCK_TYPE or with LOCK_TYPE component at .1. requires an explicit interface" }
 110   call test(ll) ! { dg-error "non-INTENT.INOUT. dummy .x. at .1., which is LOCK_TYPE or has a LOCK_TYPE component" }
 111 contains
 112   subroutine test(x)
 113     type(lock_type), intent(in) :: x[*]
 114   end subroutine test
 115 end subroutine argument_check