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