[flang] Accept polymorphic component element in storage_size
[llvm-project.git] / flang / test / Semantics / image_status.f90
blob229b7c9b7de798a375fc027b7d8bc32e5c5bb88e
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
5 program test_image_status
6 use iso_fortran_env, only : team_type, stat_failed_image, stat_stopped_image
7 implicit none
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
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)
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)
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
40 !___ non-conforming statements ___
42 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -1
43 n = image_status(-1)
45 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 0
46 n = image_status(0)
48 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -4
49 n = image_status(constant_negative)
51 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 0
52 n = image_status(constant_zero)
54 !ERROR: 'team=' argument has unacceptable rank 1
55 n = image_status(1, team=league)
57 !ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
58 n = image_status(3.4)
60 !ERROR: Actual argument for 'image=' has bad type 'LOGICAL(4)'
61 n = image_status(wrong_arg_type_logical)
63 !ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
64 n = image_status(wrong_arg_type_real)
66 !ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
67 n = image_status(1, not_team_type)
69 !ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
70 n = image_status(1, 1)
72 !ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
73 n = image_status(image=3.4)
75 !ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
76 n = image_status(1, team=1)
78 !ERROR: too many actual arguments for intrinsic 'image_status'
79 n = image_status(1, home, 2)
81 !ERROR: repeated keyword argument to intrinsic 'image_status'
82 n = image_status(image=1, image=2)
84 !ERROR: repeated keyword argument to intrinsic 'image_status'
85 n = image_status(image=1, team=home, team=league(1))
87 !ERROR: unknown keyword argument to intrinsic 'image_status'
88 n = image_status(images=1)
90 !ERROR: unknown keyword argument to intrinsic 'image_status'
91 n = image_status(1, my_team=home)
93 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
94 result_array = image_status(image=array_with_negative)
96 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
97 result_array = image_status(image=[-2, 1])
99 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
100 result_array = image_status(image=array_with_zero)
102 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
103 result_array = image_status(image=[1, 0])
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)
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)
111 !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CHARACTER(KIND=1) and INTEGER(4)
112 wrong_result_type = image_status(1)
114 end program test_image_status