flang/test/Semantics/image_status.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Check for semantic errors in image_status(), as defined in
   3 ! section 16.9.98 of the Fortran 2018 standard
   4
   5 program test_image_status
   6   use iso_fortran_env, only : team_type, stat_failed_image, stat_stopped_image
   7   implicit none
   8
   9   type(team_type) home, league(2)
  10   integer n, image_num, array(5), coindexed[*], non_array_result, array_2d(10, 10), not_team_type
  11   integer, parameter :: array_with_negative(2) = [-2, 1]
  12   integer, parameter :: array_with_zero(2) = [1, 0]
  13   integer, parameter :: constant_integer = 2, constant_negative = -4, constant_zero = 0
  14   integer, allocatable :: result_array(:), result_array_2d(:,:), wrong_rank_result(:)
  15   logical wrong_arg_type_logical
  16   real wrong_arg_type_real
  17   character wrong_result_type
  18
  19   !___ standard-conforming statements ___
  20   n = image_status(1)
  21   n = image_status(constant_integer)
  22   n = image_status(image_num)
  23   n = image_status(array(1))
  24   n = image_status(coindexed[1])
  25   n = image_status(image=1)
  26   result_array = image_status(array)
  27   result_array_2d = image_status(array_2d)
  28
  29   n = image_status(2, home)
  30   n = image_status(2, league(1))
  31   n = image_status(image=2, team=home)
  32   n = image_status(team=home, image=2)
  33
  34   if (image_status(1) .eq. stat_failed_image .or. image_status(1) .eq. stat_stopped_image) then
  35      error stop
  36   else if (image_status(1) .eq. 0) then
  37      continue
  38   end if
  39
  40   !___ non-conforming statements ___
  41
  42   !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -1
  43   n = image_status(-1)
  44
  45   !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 0
  46   n = image_status(0)
  47
  48   !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -4
  49   n = image_status(constant_negative)
  50
  51   !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 0
  52   n = image_status(constant_zero)
  53
  54   !ERROR: 'team=' argument has unacceptable rank 1
  55   n = image_status(1, team=league)
  56
  57   !ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
  58   n = image_status(3.4)
  59
  60   !ERROR: Actual argument for 'image=' has bad type 'LOGICAL(4)'
  61   n = image_status(wrong_arg_type_logical)
  62
  63   !ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
  64   n = image_status(wrong_arg_type_real)
  65
  66   !ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
  67   n = image_status(1, not_team_type)
  68
  69   !ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
  70   n = image_status(1, 1)
  71
  72   !ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
  73   n = image_status(image=3.4)
  74
  75   !ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
  76   n = image_status(1, team=1)
  77
  78   !ERROR: too many actual arguments for intrinsic 'image_status'
  79   n = image_status(1, home, 2)
  80
  81   !ERROR: repeated keyword argument to intrinsic 'image_status'
  82   n = image_status(image=1, image=2)
  83
  84   !ERROR: repeated keyword argument to intrinsic 'image_status'
  85   n = image_status(image=1, team=home, team=league(1))
  86
  87   !ERROR: unknown keyword argument to intrinsic 'image_status'
  88   n = image_status(images=1)
  89
  90   !ERROR: unknown keyword argument to intrinsic 'image_status'
  91   n = image_status(1, my_team=home)
  92
  93   !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
  94   result_array = image_status(image=array_with_negative)
  95
  96   !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
  97   result_array = image_status(image=[-2, 1])
  98
  99   !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
 100   result_array = image_status(image=array_with_zero)
 101
 102   !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
 103   result_array = image_status(image=[1, 0])
 104
 105   !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
 106   non_array_result = image_status(image=array)
 107
 108   !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches rank 1 array of INTEGER(4) and rank 2 array of INTEGER(4)
 109   wrong_rank_result = image_status(array_2d)
 110
 111   !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CHARACTER(KIND=1) and INTEGER(4)
 112   wrong_result_type = image_status(1)
 113
 114 end program test_image_status