xref: /llvm-project/flang/test/Semantics/image_status.f90 (revision 9bb18a983f2f41dc0f933f1263678e66ee912fa8) 
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
5program 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
114end program test_image_status
115