Skip to content

Commit a2d4a4c

Browse files
yiwu0b11llvmbot
authored andcommitted
Apply kind code check on exitstat and cmdstat (#78286)
When testing on gcc, both exitstat and cmdstat must be a kind=4 integer, e.g. DefaultInt. This patch changes the input arg requirement from `AnyInt` to `TypePattern{IntType, KindCode::greaterOrEqualToKind, n}`. The standard stated in 16.9.73 - EXITSTAT (optional) shall be a scalar of type integer with a decimal exponent range of at least nine. - CMDSTAT (optional) shall be a scalar of type integer with a decimal exponent range of at least four. ```fortran program bug implicit none integer(kind = 2) :: exitstatvar integer(kind = 4) :: cmdstatvar character(len=256) :: msg character(len=:), allocatable :: command command='echo hello' call execute_command_line(command, exitstat=exitstatvar, cmdstat=cmdstatvar) end program ``` When testing the above program with exitstatvar kind<4, an error would occur: ``` $ ../build-release/bin/flang-new test.f90 error: Semantic errors in test.f90 ./test.f90:8:47: error: Actual argument for 'exitstat=' has bad type or kind 'INTEGER(2)' call execute_command_line(command, exitstat=exitstatvar) ``` When testing the above program with exitstatvar kind<2, an error would occur: ``` $ ../build-release/bin/flang-new test.f90 error: Semantic errors in test.f90 ./test.f90:8:47: error: Actual argument for 'cmdstat=' has bad type or kind 'INTEGER(1)' call execute_command_line(command, cmdstat=cmdstatvar) ``` Test file for this semantics has been added to `flang/test/Semantic` Fixes: #77990 (cherry picked from commit 14a1510)
1 parent bab01ae commit a2d4a4c

File tree

3 files changed

+50
-14
lines changed

3 files changed

+50
-14
lines changed

flang/docs/Intrinsics.md

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -852,13 +852,13 @@ used in constant expressions have currently no folding support at all.
852852
- **Syntax:** `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])`
853853
- **Arguments:**
854854

855-
| Argument | Description |
856-
|-----------|--------------------------------------------------------------|
857-
| `COMMAND` | Shall be a default CHARACTER scalar. |
858-
| `WAIT` | (Optional) Shall be a default LOGICAL scalar. |
859-
| `EXITSTAT`| (Optional) Shall be an INTEGER of the default kind. |
860-
| `CMDSTAT` | (Optional) Shall be an INTEGER of the default kind. |
861-
| `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. |
855+
| Argument | Description |
856+
|------------|-----------------------------------------------------------------------|
857+
| `COMMAND` | Shall be a default CHARACTER scalar. |
858+
| `WAIT` | (Optional) Shall be a default LOGICAL scalar. |
859+
| `EXITSTAT` | (Optional) Shall be an INTEGER with kind greater than or equal to 4. |
860+
| `CMDSTAT` | (Optional) Shall be an INTEGER with kind greater than or equal to 2. |
861+
| `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. |
862862

863863
#### Implementation Specifics
864864

flang/lib/Evaluate/intrinsics.cpp

Lines changed: 14 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -78,6 +78,8 @@ static constexpr CategorySet AnyType{IntrinsicType | DerivedType};
7878
ENUM_CLASS(KindCode, none, defaultIntegerKind,
7979
defaultRealKind, // is also the default COMPLEX kind
8080
doublePrecision, defaultCharKind, defaultLogicalKind,
81+
greaterOrEqualToKind, // match kind value greater than or equal to a single
82+
// explicit kind value
8183
any, // matches any kind value; each instance is independent
8284
// match any kind, but all "same" kinds must be equal. For characters, also
8385
// implies that lengths must be equal.
@@ -104,7 +106,7 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind,
104106
struct TypePattern {
105107
CategorySet categorySet;
106108
KindCode kindCode{KindCode::none};
107-
int exactKindValue{0}; // for KindCode::exactKind
109+
int kindValue{0}; // for KindCode::exactKind and greaterOrEqualToKind
108110
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
109111
};
110112

@@ -1314,10 +1316,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{
13141316
{"execute_command_line",
13151317
{{"command", DefaultChar, Rank::scalar},
13161318
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
1317-
{"exitstat", AnyInt, Rank::scalar, Optionality::optional,
1318-
common::Intent::InOut},
1319-
{"cmdstat", AnyInt, Rank::scalar, Optionality::optional,
1320-
common::Intent::Out},
1319+
{"exitstat",
1320+
TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
1321+
Rank::scalar, Optionality::optional, common::Intent::InOut},
1322+
{"cmdstat", TypePattern{IntType, KindCode::greaterOrEqualToKind, 2},
1323+
Rank::scalar, Optionality::optional, common::Intent::Out},
13211324
{"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional,
13221325
common::Intent::InOut}},
13231326
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
@@ -1834,7 +1837,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
18341837
argOk = true;
18351838
break;
18361839
case KindCode::exactKind:
1837-
argOk = type->kind() == d.typePattern.exactKindValue;
1840+
argOk = type->kind() == d.typePattern.kindValue;
1841+
break;
1842+
case KindCode::greaterOrEqualToKind:
1843+
argOk = type->kind() >= d.typePattern.kindValue;
18381844
break;
18391845
case KindCode::sameAtom:
18401846
if (!sameArg) {
@@ -2177,8 +2183,9 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
21772183
resultType = DynamicType{
21782184
GetBuiltinDerivedType(builtinsScope, "__builtin_team_type")};
21792185
break;
2186+
case KindCode::greaterOrEqualToKind:
21802187
case KindCode::exactKind:
2181-
resultType = DynamicType{*category, result.exactKindValue};
2188+
resultType = DynamicType{*category, result.kindValue};
21822189
break;
21832190
case KindCode::typeless:
21842191
case KindCode::any:
Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2+
! Tests for the EXECUTE_COMMAND_LINE intrinsics
3+
4+
subroutine bad_kind_error(command, exitVal, cmdVal)
5+
CHARACTER(30) :: command
6+
INTEGER(KIND=2) :: exitVal
7+
INTEGER(KIND=1) :: cmdVal
8+
!ERROR: Actual argument for 'exitstat=' has bad type or kind 'INTEGER(2)'
9+
call execute_command_line(command, exitstat=exitVal)
10+
11+
!ERROR: Actual argument for 'cmdstat=' has bad type or kind 'INTEGER(1)'
12+
call execute_command_line(command, cmdstat=cmdVal)
13+
end subroutine bad_kind_error
14+
15+
subroutine good_kind_equal(command, exitVal, cmdVal)
16+
CHARACTER(30) :: command
17+
INTEGER(KIND=4) :: exitVal
18+
INTEGER(KIND=2) :: cmdVal
19+
call execute_command_line(command, exitstat=exitVal)
20+
call execute_command_line(command, cmdstat=cmdVal)
21+
end subroutine good_kind_equal
22+
23+
subroutine good_kind_greater(command, exitVal, cmdVal)
24+
CHARACTER(30) :: command
25+
INTEGER(KIND=8) :: exitVal
26+
INTEGER(KIND=4) :: cmdVal
27+
call execute_command_line(command, exitstat=exitVal)
28+
call execute_command_line(command, cmdstat=cmdVal)
29+
end subroutine good_kind_greater

0 commit comments

Comments
 (0)