mirror of
https://github.com/capstone-engine/llvm-capstone.git
synced 2024-11-26 23:21:11 +00:00
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
llvmbot
parent
bab01aead7
commit
a2d4a4c0b2
@ -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
|
||||
|
||||
|
||||
@ -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<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) {
|
||||
@ -2177,8 +2183,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:
|
||||
|
||||
29
flang/test/Semantics/execute_command_line.f90
Normal file
29
flang/test/Semantics/execute_command_line.f90
Normal 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
|
||||
Loading…
Reference in New Issue
Block a user