[flang-commits] [flang] 14a1510 - Apply kind code check on exitstat and cmdstat (#78286)
via flang-commits
flang-commits at lists.llvm.org
Mon Jan 29 03:13:29 PST 2024
Author: Yi Wu
Date: 2024-01-29T11:13:25Z
New Revision: 14a15103cc9dbdb3e95c04627e0b96b5e3aa4944
URL: https://github.com/llvm/llvm-project/commit/14a15103cc9dbdb3e95c04627e0b96b5e3aa4944
DIFF: https://github.com/llvm/llvm-project/commit/14a15103cc9dbdb3e95c04627e0b96b5e3aa4944.diff
LOG: 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
Added:
flang/test/Semantics/execute_command_line.f90
Modified:
flang/docs/Intrinsics.md
flang/lib/Evaluate/intrinsics.cpp
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index c40bcb886bc7c65..ff797653752123a 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 fea8180bbf2f315..10e66d7d8ae7bdc 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;
};
@@ -1320,10 +1322,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},
@@ -1856,7 +1859,10 @@ std::optional<SpecificCall> 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) {
@@ -2199,8 +2205,9 @@ std::optional<SpecificCall> 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 000000000000000..a66bbce705715d3
--- /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
More information about the flang-commits
mailing list