diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 5ade257403297..5ad6d01e8a8ed 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 da6d597008988..1701a475942ff 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 0000000000000..a66bbce705715 --- /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