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)
This commit is contained in:
Yi Wu 2024-01-29 11:13:25 +00:00 committed by llvmbot
parent bab01aead7
commit a2d4a4c0b2
3 changed files with 50 additions and 14 deletions

View File

@ -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 ])` - **Syntax:** `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])`
- **Arguments:** - **Arguments:**
| Argument | Description | | Argument | Description |
|-----------|--------------------------------------------------------------| |------------|-----------------------------------------------------------------------|
| `COMMAND` | Shall be a default CHARACTER scalar. | | `COMMAND` | Shall be a default CHARACTER scalar. |
| `WAIT` | (Optional) Shall be a default LOGICAL scalar. | | `WAIT` | (Optional) Shall be a default LOGICAL scalar. |
| `EXITSTAT`| (Optional) Shall be an INTEGER of the default kind. | | `EXITSTAT` | (Optional) Shall be an INTEGER with kind greater than or equal to 4. |
| `CMDSTAT` | (Optional) Shall be an INTEGER of the default kind. | | `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. | | `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. |
#### Implementation Specifics #### Implementation Specifics

View File

@ -78,6 +78,8 @@ static constexpr CategorySet AnyType{IntrinsicType | DerivedType};
ENUM_CLASS(KindCode, none, defaultIntegerKind, ENUM_CLASS(KindCode, none, defaultIntegerKind,
defaultRealKind, // is also the default COMPLEX kind defaultRealKind, // is also the default COMPLEX kind
doublePrecision, defaultCharKind, defaultLogicalKind, 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 any, // matches any kind value; each instance is independent
// match any kind, but all "same" kinds must be equal. For characters, also // match any kind, but all "same" kinds must be equal. For characters, also
// implies that lengths must be equal. // implies that lengths must be equal.
@ -104,7 +106,7 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind,
struct TypePattern { struct TypePattern {
CategorySet categorySet; CategorySet categorySet;
KindCode kindCode{KindCode::none}; 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; llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
}; };
@ -1314,10 +1316,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"execute_command_line", {"execute_command_line",
{{"command", DefaultChar, Rank::scalar}, {{"command", DefaultChar, Rank::scalar},
{"wait", AnyLogical, Rank::scalar, Optionality::optional}, {"wait", AnyLogical, Rank::scalar, Optionality::optional},
{"exitstat", AnyInt, Rank::scalar, Optionality::optional, {"exitstat",
common::Intent::InOut}, TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
{"cmdstat", AnyInt, Rank::scalar, Optionality::optional, Rank::scalar, Optionality::optional, common::Intent::InOut},
common::Intent::Out}, {"cmdstat", TypePattern{IntType, KindCode::greaterOrEqualToKind, 2},
Rank::scalar, Optionality::optional, common::Intent::Out},
{"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional, {"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional,
common::Intent::InOut}}, common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
@ -1834,7 +1837,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
argOk = true; argOk = true;
break; break;
case KindCode::exactKind: 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; break;
case KindCode::sameAtom: case KindCode::sameAtom:
if (!sameArg) { if (!sameArg) {
@ -2177,8 +2183,9 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
resultType = DynamicType{ resultType = DynamicType{
GetBuiltinDerivedType(builtinsScope, "__builtin_team_type")}; GetBuiltinDerivedType(builtinsScope, "__builtin_team_type")};
break; break;
case KindCode::greaterOrEqualToKind:
case KindCode::exactKind: case KindCode::exactKind:
resultType = DynamicType{*category, result.exactKindValue}; resultType = DynamicType{*category, result.kindValue};
break; break;
case KindCode::typeless: case KindCode::typeless:
case KindCode::any: case KindCode::any:

View File

@ -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