1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
  
     | 
    
      ! RUN: %python %S/test_errors.py %s %flang_fc1
! This test checks for semantic errors in atomic_fetch_and subroutine calls based on
! the interface defined in section 16.9.25 of the Fortran 2018 standard.
program test_atomic_fetch_and
  use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
  implicit none
  integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
  integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)
  integer :: status, default_kind_coarray[*], not_same_kind_as_atom, coindexed_status[*]
  integer :: extra_arg, repeated_status, status_array(10)
  integer(kind=1) :: kind1_coarray[*]
  real :: non_integer_coarray[*], not_same_type_as_atom
  logical :: non_integer
  logical(kind=atomic_logical_kind) :: atomic_logical[*], old_logical
  !___ standard-conforming calls ___
  call atomic_fetch_and(scalar_coarray, val, old_val)
  call atomic_fetch_and(scalar_coarray[1], val, old_val)
  call atomic_fetch_and(scalar_coarray, val, old_val, status)
  call atomic_fetch_and(scalar_coarray[1], val, old_val, status)
  call atomic_fetch_and(atom=scalar_coarray, value=val, old=old_val, stat=status)
  call atomic_fetch_and(stat=status, old=old_val, value=val, atom=scalar_coarray)
  !___ non-standard-conforming calls ___
  !ERROR: Actual argument for 'atom=' has bad type 'LOGICAL(8)'
  call atomic_fetch_and(atomic_logical, val, old_logical)
  !ERROR: Actual argument for 'old=' has bad type 'LOGICAL(8)'
  call atomic_fetch_and(scalar_coarray, val, old_logical)
  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(non_scalar_coarray, val, old_val)
  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(non_coarray, val, old_val)
  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(array, val, old_val)
  !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(non_scalar_coarray[1], val, old_val)
  !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
  call atomic_fetch_and(default_kind_coarray, val, old_val)
  !ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(1)'
  call atomic_fetch_and(kind1_coarray, val, old_val)
  !ERROR: Actual argument for 'atom=' has bad type 'REAL(4)'
  call atomic_fetch_and(non_integer_coarray, val, old_val)
  !ERROR: 'value=' argument has unacceptable rank 1
  call atomic_fetch_and(scalar_coarray, array, old_val)
  !ERROR: Actual argument for 'value=' has bad type 'LOGICAL(4)'
  call atomic_fetch_and(scalar_coarray, non_integer, old_val)
  !ERROR: Actual argument for 'old=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
  call atomic_fetch_and(atom=scalar_coarray, value=val, old=not_same_kind_as_atom)
  !ERROR: Actual argument for 'old=' has bad type 'REAL(4)'
  call atomic_fetch_and(atom=scalar_coarray, value=val, old=not_same_type_as_atom)
  !ERROR: Actual argument for 'old=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
  call atomic_fetch_and(scalar_coarray, val, 1)
  !ERROR: 'old=' argument has unacceptable rank 1
  call atomic_fetch_and(scalar_coarray, val, array)
  !ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
  call atomic_fetch_and(scalar_coarray, val, old_val, non_integer)
  !ERROR: 'stat=' argument has unacceptable rank 1
  call atomic_fetch_and(scalar_coarray, val, old_val, status_array)
  !ERROR: 'stat' argument to 'atomic_fetch_and' may not be a coindexed object
  call atomic_fetch_and(scalar_coarray, val, old_val, coindexed_status[1])
  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
  !BECAUSE: '1_4' is not a variable or pointer
  call atomic_fetch_and(scalar_coarray, val, old_val, 1)
  !ERROR: missing mandatory 'atom=' argument
  call atomic_fetch_and()
  !ERROR: missing mandatory 'atom=' argument
  call atomic_fetch_and(value=val, old=old_val, stat=status)
  !ERROR: missing mandatory 'value=' argument
  call atomic_fetch_and(scalar_coarray)
  !ERROR: missing mandatory 'value=' argument
  call atomic_fetch_and(atom=scalar_coarray, old=old_val, stat=status)
  !ERROR: missing mandatory 'old=' argument
  call atomic_fetch_and(scalar_coarray, val)
  !ERROR: missing mandatory 'old=' argument
  call atomic_fetch_and(atom=scalar_coarray, value=val)
  !ERROR: too many actual arguments for intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(scalar_coarray, val, old_val, status, extra_arg)
  !ERROR: repeated keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, atom=repeated_atom, value=val, old=old_val, stat=status)
  !ERROR: repeated keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, value=val, value=repeated_val, old=old_val, stat=status)
  !ERROR: repeated keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, value=val, old=old_val, old=repeated_old, stat=status)
  !ERROR: repeated keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, value=val, old=old_val, stat=status, stat=repeated_status)
  !ERROR: unknown keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atomic=scalar_coarray, value=val, old=old_val, stat=status)
  !ERROR: unknown keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, values=val, old=old_val, stat=status)
  !ERROR: unknown keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, value=val, oldvalue=old_val, stat=status)
  !ERROR: unknown keyword argument to intrinsic 'atomic_fetch_and'
  call atomic_fetch_and(atom=scalar_coarray, value=val, old=old_val, status=status)
  !ERROR: keyword argument to intrinsic 'atomic_fetch_and' was supplied positionally by an earlier actual argument
  call atomic_fetch_and(scalar_coarray, val, old_val, atom=repeated_atom)
  !ERROR: keyword argument to intrinsic 'atomic_fetch_and' was supplied positionally by an earlier actual argument
  call atomic_fetch_and(scalar_coarray, val, old_val, value=repeated_val)
  !ERROR: keyword argument to intrinsic 'atomic_fetch_and' was supplied positionally by an earlier actual argument
  call atomic_fetch_and(scalar_coarray, val, old_val, status, stat=repeated_status)
end program test_atomic_fetch_and
 
     |