[llvm-branch-commits] [flang] PR for llvm/llvm-project#80028 (PR #80031)

via llvm-branch-commits llvm-branch-commits at lists.llvm.org
Tue Jan 30 08:46:16 PST 2024


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: None (llvmbot)

<details>
<summary>Changes</summary>

resolves llvm/llvm-project#<!-- -->80028

---
Full diff: https://github.com/llvm/llvm-project/pull/80031.diff


3 Files Affected:

- (modified) flang/docs/Intrinsics.md (+7-7) 
- (modified) flang/lib/Evaluate/intrinsics.cpp (+14-7) 
- (added) flang/test/Semantics/execute_command_line.f90 (+29) 


``````````diff
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

``````````

</details>


https://github.com/llvm/llvm-project/pull/80031


More information about the llvm-branch-commits mailing list