flang/test/Semantics/collectives02.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! This test checks for semantic errors in co_min subroutine calls based on
   3 ! the co_min interface defined in section 16.9.48 of the Fortran 2018 standard.
   4
   5 program test_co_min
   6   implicit none
   7
   8   integer          i, integer_array(1), coindexed_integer[*], status, coindexed_result_image[*], repeated_status
   9   character(len=1) c, character_array(1), coindexed_character[*], message, repeated_message
  10   double precision d, double_precision_array(1)
  11   real             r, real_array(1), coindexed_real[*]
  12   complex          complex_type
  13   logical          bool
  14
  15   !___ standard-conforming calls with no keyword arguments ___
  16   call co_min(i)
  17   call co_min(c)
  18   call co_min(d)
  19   call co_min(r)
  20   call co_min(i, 1)
  21   call co_min(c, 1, status)
  22   call co_min(d, 1, status, message)
  23   call co_min(r, 1, status, message)
  24   call co_min(integer_array)
  25   call co_min(character_array, 1)
  26   call co_min(double_precision_array, 1, status)
  27   call co_min(real_array, 1, status, message)
  28
  29   !___ standard-conforming calls with keyword arguments ___
  30
  31   ! all arguments present
  32   call co_min(a=i, result_image=1, stat=status, errmsg=message)
  33   call co_min(result_image=1, a=i, errmsg=message, stat=status)
  34
  35   ! one optional argument not present
  36   call co_min(a=i,                 stat=status, errmsg=message)
  37   call co_min(a=i, result_image=1,              errmsg=message)
  38   call co_min(a=i, result_image=1, stat=status                )
  39
  40   ! two optional arguments not present
  41   call co_min(a=i, result_image=1                             )
  42   call co_min(a=i,                 stat=status                )
  43   call co_min(a=i,                              errmsg=message)
  44   call co_min(a=i, result_image=coindexed_result_image[1]     )
  45
  46   ! no optional arguments present
  47   call co_min(a=i)
  48
  49   !___ non-standard-conforming calls ___
  50
  51   !ERROR: missing mandatory 'a=' argument
  52   call co_min()
  53
  54   !ERROR: repeated keyword argument to intrinsic 'co_min'
  55   call co_min(a=i, a=c)
  56
  57   !ERROR: repeated keyword argument to intrinsic 'co_min'
  58   call co_min(d, result_image=1, result_image=3)
  59
  60   !ERROR: repeated keyword argument to intrinsic 'co_min'
  61   call co_min(d, 1, stat=status, stat=repeated_status)
  62
  63   !ERROR: repeated keyword argument to intrinsic 'co_min'
  64   call co_min(d, 1, status, errmsg=message, errmsg=repeated_message)
  65
  66   !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
  67   call co_min(i, 1, a=c)
  68
  69   !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
  70   call co_min(i, 1, status, result_image=1)
  71
  72   !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
  73   call co_min(i, 1, status, stat=repeated_status)
  74
  75   !ERROR: keyword argument to intrinsic 'co_min' was supplied positionally by an earlier actual argument
  76   call co_min(i, 1, status, message, errmsg=repeated_message)
  77
  78   ! argument 'a' shall be of numeric type
  79   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
  80   call co_min(bool)
  81
  82   ! argument 'a' shall be of numeric type
  83   !ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
  84   call co_min(complex_type)
  85
  86   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
  87   !BECAUSE: '2_4' is not a variable or pointer
  88   call co_min(a=1+1)
  89
  90   !ERROR: 'a' argument to 'co_min' may not be a coindexed object
  91   call co_min(a=coindexed_real[1])
  92
  93   !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
  94   call co_min(i, result_image=bool)
  95
  96   !ERROR: 'result_image=' argument has unacceptable rank 1
  97   call co_min(c, result_image=integer_array)
  98
  99   !ERROR: 'stat' argument to 'co_min' may not be a coindexed object
 100   call co_min(d, stat=coindexed_integer[1])
 101
 102   ! 'stat' argument shall be an integer
 103   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
 104   call co_min(r, stat=message)
 105
 106   !ERROR: 'stat=' argument has unacceptable rank 1
 107   call co_min(i, stat=integer_array)
 108
 109   !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
 110   !BECAUSE: '"c"' is not a variable or pointer
 111   call co_min(a=i, result_image=1, stat=status, errmsg='c')
 112
 113   !ERROR: 'errmsg' argument to 'co_min' may not be a coindexed object
 114   call co_min(c, errmsg=coindexed_character[1])
 115
 116   ! 'errmsg' argument shall be a character
 117   !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
 118   call co_min(c, errmsg=i)
 119
 120   !ERROR: 'errmsg=' argument has unacceptable rank 1
 121   call co_min(d, errmsg=character_array)
 122
 123   !ERROR: too many actual arguments for intrinsic 'co_min'
 124   call co_min(r, result_image=1, stat=status, errmsg=message, 3.4)
 125
 126   !ERROR: unknown keyword argument to intrinsic 'co_min'
 127   call co_min(fake=3.4)
 128
 129   !ERROR: 'a' argument to 'co_min' may not be a coindexed object
 130   !ERROR: 'errmsg' argument to 'co_min' may not be a coindexed object
 131   !ERROR: 'stat' argument to 'co_min' may not be a coindexed object
 132   call co_min(result_image=coindexed_result_image[1], a=coindexed_real[1], errmsg=coindexed_character[1], stat=coindexed_integer[1])
 133
 134 end program test_co_min