flang/test/Semantics/coshape.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! XFAIL: *
   3 ! Check for semantic errors in coshape() function,
   4 ! as defined in section 16.9.55 of the Fortran
   5 ! 2018 standard
   6
   7 program coshape_tests
   8   use iso_c_binding, only : c_int32_t, c_int64_t
   9   implicit none
  10
  11   integer array(1), non_coarray(1), scalar_coarray[*], array_coarray(1)[*], non_constant, scalar_result
  12   real real_coarray[*]
  13   complex complex_coarray[*]
  14   character char_array(1)
  15   logical non_integer, logical_coarray[*]
  16   integer, allocatable :: codimensions(:)
  17
  18   !___ standard-conforming statement with no optional arguments present ___
  19   codimensions = coshape(scalar_coarray)
  20   codimensions = coshape(array_coarray)
  21   codimensions = coshape(array_coarray(1))
  22   codimensions = coshape(scalar_coarray[1])
  23   codimensions = coshape(real_coarray)
  24   codimensions = coshape(logical_coarray)
  25   codimensions = coshape(complex_coarray)
  26   codimensions = coshape(coarray=scalar_coarray)
  27
  28   !___ standard-conforming statements with optional kind argument present ___
  29   codimensions = coshape(scalar_coarray, c_int32_t)
  30   codimensions = coshape(real_coarray, kind=c_int32_t)
  31   codimensions = coshape(coarray=logical_coarray, kind=c_int32_t)
  32   codimensions = coshape(kind=c_int32_t, coarray=complex_coarray)
  33
  34   !___ non-conforming statements ___
  35   ! coarray argument must be a coarray
  36   codimensions = coshape(non_coarray)
  37
  38   ! kind argument must be an integer
  39   codimensions = coshape(scalar_coarray, non_integer)
  40
  41   ! kind argument must be a constant expression
  42   codimensions = coshape(real_coarray, non_constant)
  43
  44   ! kind argument must be an integer scalar
  45   codimensions = coshape(complex_coarray, array)
  46
  47   ! missing all arguments
  48   codimensions = coshape()
  49
  50   ! missing mandatory argument
  51   codimensions = coshape(kind=c_int32_t)
  52
  53   ! incorrect typing for mandatory argument
  54   codimensions = coshape(3.4)
  55
  56   ! incorrect typing for coarray argument
  57   codimensions = coshape(coarray=3.4)
  58
  59   ! too many arguments
  60   codimensions = coshape(scalar_coarray, c_int32_t, 0)
  61
  62   ! incorrect typing with correct keyword for coarray argument
  63   codimensions = coshape(coarray=non_coarray)
  64
  65   ! correct typing with incorrect keyword for coarray argument
  66   codimensions = coshape(c=real_coarray)
  67
  68   ! incorrect typing with correct keyword for kind argument
  69   codimensions = coshape(complex_coarray, kind=non_integer)
  70
  71   ! correct typing with incorrect keyword for kind argument
  72   codimensions = coshape(logical_coarray, kinds=c_int32_t)
  73
  74   ! repeated keyword for coarray argument
  75   codimensions = coshape(coarray=scalar_coarray, coarray=real_coarray)
  76
  77   ! repeated keyword for kind argument
  78   codimensions = coshape(real_coarray, kind=c_int32_t, kind=c_int64_t)
  79
  80   ! result must be a rank 1 array
  81   scalar_result = coshape(scalar_coarray)
  82
  83   ! result must be an integer array
  84   char_array = coshape(real_coarray)
  85
  86 end program coshape_tests