flang/test/Semantics/collectives01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! XFAIL: *
   3 ! This test checks for semantic errors in co_sum subroutine calls based on
   4 ! the co_reduce interface defined in section 16.9.50 of the Fortran 2018 standard.
   5 ! To Do: add co_sum to the list of intrinsics
   6
   7 program test_co_sum
   8   implicit none
   9
  10   integer i, status, integer_array(1), coindexed_integer[*]
  11   complex c, complex_array(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1)
  12   double precision d, double_precision_array(1)
  13   real r, real_array(1), coindexed_real[*]
  14
  15   character(len=1) message, coindexed_character[*], character_array(1)
  16   logical bool
  17
  18   !___ standard-conforming calls with no keyword arguments ___
  19   call co_sum(i)
  20   call co_sum(c)
  21   call co_sum(d)
  22   call co_sum(r)
  23   call co_sum(i, 1)
  24   call co_sum(c, 1, status)
  25   call co_sum(d, 1, status, message)
  26   call co_sum(r, 1, status, message)
  27   call co_sum(integer_array)
  28   call co_sum(complex_array, 1)
  29   call co_sum(double_precision_array, 1, status)
  30   call co_sum(real_array, 1, status, message)
  31
  32   !___ standard-conforming calls with keyword arguments ___
  33
  34   ! all arguments present
  35   call co_sum(a=i, result_image=1, stat=status, errmsg=message)
  36
  37   ! one optional argument not present
  38   call co_sum(a=i,                 stat=status, errmsg=message)
  39   call co_sum(a=i, result_image=1,              errmsg=message)
  40   call co_sum(a=i, result_image=1, stat=status                )
  41
  42   ! two optional arguments not present
  43   call co_sum(a=i, result_image=1                             )
  44   call co_sum(a=i,                 stat=status                )
  45   call co_sum(a=i,                              errmsg=message)
  46
  47   ! no optional arguments present
  48   call co_sum(a=i                                             )
  49
  50   !___ non-standard-conforming calls ___
  51
  52   !ERROR: missing mandatory 'a=' argument
  53   call co_sum(result_image=1, stat=status, errmsg=message)
  54
  55   ! argument 'a' shall be of numeric type
  56   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
  57   call co_sum(bool)
  58
  59   ! argument 'a' is intent(inout)
  60   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
  61   call co_sum(a=1+1)
  62
  63   ! argument 'a' shall not be a coindexed object
  64   !ERROR: to be determined
  65   call co_sum(a=coindexed_real[1])
  66
  67   ! 'result_image' argument shall be a integer
  68   !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
  69   call co_sum(i, result_image=bool)
  70
  71   ! 'result_image' argument shall be an integer scalar
  72   !ERROR: 'result_image=' argument has unacceptable rank 1
  73   call co_sum(c, result_image=integer_array)
  74
  75   ! argument 'stat' shall be intent(out)
  76   !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
  77   call co_sum(a=i, result_image=1, stat=1+1, errmsg=message)
  78
  79   ! 'stat' argument shall be noncoindexed
  80   !ERROR: to be determined
  81   call co_sum(d, stat=coindexed_integer[1])
  82
  83   ! 'stat' argument shall be an integer
  84   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
  85   call co_sum(r, stat=message)
  86
  87   ! 'stat' argument shall be an integer scalar
  88   !ERROR: 'stat=' argument has unacceptable rank 1
  89   call co_sum(i, stat=integer_array)
  90
  91   ! 'errmsg' argument shall be intent(inout)
  92   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
  93   call co_sum(a=i, result_image=1, stat=status, errmsg='c')
  94
  95   ! 'errmsg' argument shall be noncoindexed
  96   !ERROR: to be determined
  97   call co_sum(c, errmsg=coindexed_character[1])
  98
  99   ! 'errmsg' argument shall be character scalar
 100   !ERROR: 'errmsg=' argument has unacceptable rank 1
 101   call co_sum(d, errmsg=character_array)
 102
 103   ! the error is seen as too many arguments to the co_sum() call
 104   !ERROR: too many actual arguments for intrinsic 'co_sum'
 105   call co_sum(r, result_image=1, stat=status, errmsg=message, 3.4)
 106
 107   ! keyword argument with incorrect name
 108   !ERROR: unknown keyword argument to intrinsic 'co_sum'
 109   call co_sum(fake=3.4)
 110
 111 end program test_co_sum