From a2d4a4c0b24ebb8b4194a2bb4e2a315bdbd0e90e Mon Sep 17 00:00:00 2001 From: Yi Wu <43659785+yi-wu-arm@users.noreply.github.com> Date: Mon, 29 Jan 2024 11:13:25 +0000 Subject: [PATCH] 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: https://github.com/llvm/llvm-project/issues/77990 (cherry picked from commit 14a15103cc9dbdb3e95c04627e0b96b5e3aa4944) --- flang/docs/Intrinsics.md | 14 ++++----- flang/lib/Evaluate/intrinsics.cpp | 21 +++++++++----- flang/test/Semantics/execute_command_line.f90 | 29 +++++++++++++++++++ 3 files changed, 50 insertions(+), 14 deletions(-) create mode 100644 flang/test/Semantics/execute_command_line.f90 diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 5ade25740329..5ad6d01e8a8e 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -852,13 +852,13 @@ used in constant expressions have currently no folding support at all. - **Syntax:** `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])` - **Arguments:** - | Argument | Description | - |-----------|--------------------------------------------------------------| - | `COMMAND` | Shall be a default CHARACTER scalar. | - | `WAIT` | (Optional) Shall be a default LOGICAL scalar. | - | `EXITSTAT`| (Optional) Shall be an INTEGER of the default kind. | - | `CMDSTAT` | (Optional) Shall be an INTEGER of the default kind. | - | `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. | +| Argument | Description | +|------------|-----------------------------------------------------------------------| +| `COMMAND` | Shall be a default CHARACTER scalar. | +| `WAIT` | (Optional) Shall be a default LOGICAL scalar. | +| `EXITSTAT` | (Optional) Shall be an INTEGER with kind greater than or equal to 4. | +| `CMDSTAT` | (Optional) Shall be an INTEGER with kind greater than or equal to 2. | +| `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. | #### Implementation Specifics diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index da6d59700898..1701a475942f 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -78,6 +78,8 @@ static constexpr CategorySet AnyType{IntrinsicType | DerivedType}; ENUM_CLASS(KindCode, none, defaultIntegerKind, defaultRealKind, // is also the default COMPLEX kind doublePrecision, defaultCharKind, defaultLogicalKind, + greaterOrEqualToKind, // match kind value greater than or equal to a single + // explicit kind value any, // matches any kind value; each instance is independent // match any kind, but all "same" kinds must be equal. For characters, also // implies that lengths must be equal. @@ -104,7 +106,7 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind, struct TypePattern { CategorySet categorySet; KindCode kindCode{KindCode::none}; - int exactKindValue{0}; // for KindCode::exactKind + int kindValue{0}; // for KindCode::exactKind and greaterOrEqualToKind llvm::raw_ostream &Dump(llvm::raw_ostream &) const; }; @@ -1314,10 +1316,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{ {"execute_command_line", {{"command", DefaultChar, Rank::scalar}, {"wait", AnyLogical, Rank::scalar, Optionality::optional}, - {"exitstat", AnyInt, Rank::scalar, Optionality::optional, - common::Intent::InOut}, - {"cmdstat", AnyInt, Rank::scalar, Optionality::optional, - common::Intent::Out}, + {"exitstat", + TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}, + Rank::scalar, Optionality::optional, common::Intent::InOut}, + {"cmdstat", TypePattern{IntType, KindCode::greaterOrEqualToKind, 2}, + Rank::scalar, Optionality::optional, common::Intent::Out}, {"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional, common::Intent::InOut}}, {}, Rank::elemental, IntrinsicClass::impureSubroutine}, @@ -1834,7 +1837,10 @@ std::optional IntrinsicInterface::Match( argOk = true; break; case KindCode::exactKind: - argOk = type->kind() == d.typePattern.exactKindValue; + argOk = type->kind() == d.typePattern.kindValue; + break; + case KindCode::greaterOrEqualToKind: + argOk = type->kind() >= d.typePattern.kindValue; break; case KindCode::sameAtom: if (!sameArg) { @@ -2177,8 +2183,9 @@ std::optional IntrinsicInterface::Match( resultType = DynamicType{ GetBuiltinDerivedType(builtinsScope, "__builtin_team_type")}; break; + case KindCode::greaterOrEqualToKind: case KindCode::exactKind: - resultType = DynamicType{*category, result.exactKindValue}; + resultType = DynamicType{*category, result.kindValue}; break; case KindCode::typeless: case KindCode::any: diff --git a/flang/test/Semantics/execute_command_line.f90 b/flang/test/Semantics/execute_command_line.f90 new file mode 100644 index 000000000000..a66bbce70571 --- /dev/null +++ b/flang/test/Semantics/execute_command_line.f90 @@ -0,0 +1,29 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic +! Tests for the EXECUTE_COMMAND_LINE intrinsics + +subroutine bad_kind_error(command, exitVal, cmdVal) +CHARACTER(30) :: command +INTEGER(KIND=2) :: exitVal +INTEGER(KIND=1) :: cmdVal +!ERROR: Actual argument for 'exitstat=' has bad type or kind 'INTEGER(2)' +call execute_command_line(command, exitstat=exitVal) + +!ERROR: Actual argument for 'cmdstat=' has bad type or kind 'INTEGER(1)' +call execute_command_line(command, cmdstat=cmdVal) +end subroutine bad_kind_error + +subroutine good_kind_equal(command, exitVal, cmdVal) +CHARACTER(30) :: command +INTEGER(KIND=4) :: exitVal +INTEGER(KIND=2) :: cmdVal +call execute_command_line(command, exitstat=exitVal) +call execute_command_line(command, cmdstat=cmdVal) +end subroutine good_kind_equal + +subroutine good_kind_greater(command, exitVal, cmdVal) +CHARACTER(30) :: command +INTEGER(KIND=8) :: exitVal +INTEGER(KIND=4) :: cmdVal +call execute_command_line(command, exitstat=exitVal) +call execute_command_line(command, cmdstat=cmdVal) +end subroutine good_kind_greater