[llvm-branch-commits] [flang] a2d4a4c - Apply kind code check on exitstat and cmdstat (#78286)

via llvm-branch-commits llvm-branch-commits at lists.llvm.org
Tue Jan 30 15:26:13 PST 2024


Author: Yi Wu
Date: 2024-01-30T16:45:35Z
New Revision: a2d4a4c0b24ebb8b4194a2bb4e2a315bdbd0e90e

URL: https://github.com/llvm/llvm-project/commit/a2d4a4c0b24ebb8b4194a2bb4e2a315bdbd0e90e
DIFF: https://github.com/llvm/llvm-project/commit/a2d4a4c0b24ebb8b4194a2bb4e2a315bdbd0e90e.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

(cherry picked from commit 14a15103cc9dbdb3e95c04627e0b96b5e3aa4944)

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

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


        


More information about the llvm-branch-commits mailing list