Skip to content

Commit

Permalink
Apply kind code check on exitstat and cmdstat (#78286)
Browse files Browse the repository at this point in the history
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
  • Loading branch information
yi-wu-arm authored Jan 29, 2024
1 parent 2e2b6b5 commit 14a1510
Show file tree
Hide file tree
Showing 3 changed files with 50 additions and 14 deletions.
14 changes: 7 additions & 7 deletions flang/docs/Intrinsics.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
21 changes: 14 additions & 7 deletions flang/lib/Evaluate/intrinsics.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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;
};

Expand Down Expand Up @@ -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},
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -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:
Expand Down
29 changes: 29 additions & 0 deletions flang/test/Semantics/execute_command_line.f90
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 14a1510

Please sign in to comment.