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
  23   type t2
  24     type(lock_type), allocatable :: x
  25   end type t2
  26 end module m
  27
  28 subroutine sub(x)
  29   use iso_fortran_env
  30   type(lock_type), intent(out) :: x[*] ! OK
  31 end subroutine sub
  32
  33 subroutine sub1(x) ! { dg-error "is INTENT.OUT. and can thus not be an allocatable coarray or have coarray components" }
  34   use iso_fortran_env
  35   type(lock_type), allocatable, intent(out) :: x(:)[:]
  36 end subroutine sub1
  37
  38 subroutine sub2(x) ! { dg-error "is INTENT.OUT. and can thus not be an allocatable coarray or have coarray components" }
  39   use m
  40   type(t), intent(out) :: x
  41 end subroutine sub2
  42
  43 subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, nonallocatable scalar" }
  44   use m
  45   type(t), intent(inout) :: x[*]
  46 end subroutine sub3
  47
  48 subroutine sub4(x)
  49   use m
  50   type(t2), intent(inout) :: x[*] ! OK
  51 end subroutine sub4
  52
  53 subroutine lock_test
  54   use iso_fortran_env
  55   type t
  56   end type t
  57   type(lock_type) :: lock ! { dg-error "type LOCK_TYPE must be a coarray" }
  58 end subroutine lock_test
  59
  60 subroutine lock_test2
  61   use iso_fortran_env
  62   implicit none
  63   type t
  64   end type t
  65   type(t) :: x
  66   type(lock_type), save :: lock[*],lock2(2)[*]
  67   lock(t) ! { dg-error "Syntax error in LOCK statement" }
  68   lock(x) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
  69   lock(lock)
  70   lock(lock2(1))
  71   lock(lock2) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
  72   lock(lock[1]) ! OK
  73 end subroutine lock_test2
  74
  75
  76 subroutine lock_test3
  77   use iso_fortran_env
  78   type(lock_type), save :: a[*], b[*]
  79   a = b ! { dg-error "LOCK_TYPE in variable definition context" }
  80   b = lock_type() ! { dg-error "LOCK_TYPE in variable definition context" }
  81   print *, a ! { dg-error "cannot have PRIVATE components" }
  82 end subroutine lock_test3
  83
  84
  85 subroutine lock_test4
  86   use iso_fortran_env
  87   type(lock_type), allocatable :: A(:)[:]
  88   logical :: ob
  89   allocate(A(1)[*])
  90   lock(A(1), acquired_lock=ob)
  91   unlock(A(1))
  92   deallocate(A)
  93 end subroutine lock_test4
  94
  95
  96 subroutine argument_check()
  97   use iso_fortran_env
  98   type(lock_type), SAVE :: ll[*]
  99   call no_interface(ll) ! { dg-error "Actual argument of LOCK_TYPE or with LOCK_TYPE component at .1. requires an explicit interface" }
 100   call test(ll) ! { dg-error "non-INTENT.INOUT. dummy .x. at .1., which is LOCK_TYPE or has a LOCK_TYPE component" }
 101 contains
 102   subroutine test(x)
 103     type(lock_type), intent(in) :: x[*]
 104   end subroutine test
 105 end subroutine argument_check
 106
 107 ! { dg-final { cleanup-modules "m" } }