flang/test/Semantics/collectives04.f90

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