115 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Check for semantic errors in image_status(), as defined in3! section 16.9.98 of the Fortran 2018 standard4 5program test_image_status6 use iso_fortran_env, only : team_type, stat_failed_image, stat_stopped_image7 implicit none8 9 type(team_type) home, league(2)10 integer n, image_num, array(5), coindexed[*], non_array_result, array_2d(10, 10), not_team_type11 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 = 014 integer, allocatable :: result_array(:), result_array_2d(:,:), wrong_rank_result(:)15 logical wrong_arg_type_logical16 real wrong_arg_type_real17 character wrong_result_type18 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) then35 error stop36 else if (image_status(1) .eq. 0) then37 continue38 end if39 40 !___ non-conforming statements ___41 42 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -143 n = image_status(-1)44 45 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 046 n = image_status(0)47 48 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -449 n = image_status(constant_negative)50 51 !ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 052 n = image_status(constant_zero)53 54 !ERROR: 'team=' argument has unacceptable rank 155 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 values94 result_array = image_status(image=array_with_negative)95 96 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values97 result_array = image_status(image=[-2, 1])98 99 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values100 result_array = image_status(image=array_with_zero)101 102 !ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values103 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_status115