[flang][intrinsic] restrict kind of get_command(_argument) to >= 2

[akuhlens]

Previously the following program would have failed with a runtime assertion violation. This PR restricts the type information such that this assertion failure isn't reachable. The example below demonstrates the change.

$ cat error.f90
integer (kind=1) :: i
call get_command(length=i)
print *, i
end
$ cat good.f90
integer (kind=2) :: i
call get_command(length=i)
print *, i
end
$ prior/flang  error.f90 && ./a.out
fatal Fortran runtime error(/home/akuhlenschmi/work/lorado/src/llvm-project/t.f90:2): Internal error: RUNTIME_CHECK(IsValidIntDescriptor(length)) failed at /home/akuhlenschmi/work/lorado/src/llvm-project/flang-rt/lib/runtime/command.cpp(154)
Aborted (core dumped)
$ prior/flang good.f90 && ./a.out
7
$ current/flang  error.f90 && ./a.out
error: Semantic errors in t.f90
./t.f90:2:25: error: Actual argument for 'length=' has bad type or kind 'INTEGER(1)'
  call get_command(length=i)
                          ^
$ current/flang good.f90 && ./a.out
7

Also while making the change, I noticed that "get_command_argument" suffers from the same issue, so I made a similar change for it.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Andre Kuhlenschmidt (akuhlens)

Changes

Previously the following program would have failed with a runtime assertion violation. This PR restricts the type information such that this assertion failure isn't reachable. The example below demonstrates the change.

$ cat error.f90
integer (kind=1) :: i
call get_command(length=i)
print *, i
end
$ cat good.f90
integer (kind=2) :: i
call get_command(length=i)
print *, i
end
$ prior/flang  error.f90 && ./a.out
fatal Fortran runtime error(/home/akuhlenschmi/work/lorado/src/llvm-project/t.f90:2): Internal error: RUNTIME_CHECK(IsValidIntDescriptor(length)) failed at /home/akuhlenschmi/work/lorado/src/llvm-project/flang-rt/lib/runtime/command.cpp(154)
Aborted (core dumped)
$ prior/flang good.f90 && ./a.out
7
$ current/flang  error.f90 && ./a.out
error: Semantic errors in t.f90
./t.f90:2:25: error: Actual argument for 'length=' has bad type or kind 'INTEGER(1)'
  call get_command(length=i)
                          ^
$ current/flang good.f90 && ./a.out
7

---

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

2 Files Affected:

• (modified) flang/lib/Evaluate/intrinsics.cpp (+4-4)
• (added) flang/test/Semantics/command.f90 (+30)

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 709f2e6c85bb2..d64a008e3db84 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1587,8 +1587,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
     {"get_command",
         {{"command", DefaultChar, Rank::scalar, Optionality::optional,
              common::Intent::Out},
-            {"length", AnyInt, Rank::scalar, Optionality::optional,
-                common::Intent::Out},
+            {"length", TypePattern{IntType, KindCode::greaterOrEqualToKind, 2},
+                Rank::scalar, Optionality::optional, common::Intent::Out},
             {"status", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out},
             {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
@@ -1598,8 +1598,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
         {{"number", AnyInt, Rank::scalar},
             {"value", DefaultChar, Rank::scalar, Optionality::optional,
                 common::Intent::Out},
-            {"length", AnyInt, Rank::scalar, Optionality::optional,
-                common::Intent::Out},
+            {"length", TypePattern{IntType, KindCode::greaterOrEqualToKind, 2},
+                Rank::scalar, Optionality::optional, common::Intent::Out},
             {"status", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out},
             {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
diff --git a/flang/test/Semantics/command.f90 b/flang/test/Semantics/command.f90
new file mode 100644
index 0000000000000..b5f24cddbd052
--- /dev/null
+++ b/flang/test/Semantics/command.f90
@@ -0,0 +1,30 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+program command
+  implicit none
+  Integer(1) :: i1
+  Integer(2) :: i2
+  Integer(4) :: i4
+  Integer(8) :: i8
+  Integer(16) :: i16
+	Integer :: a
+  !ERROR: Actual argument for 'length=' has bad type or kind 'INTEGER(1)'
+  call get_command(length=i1)
+  !OK:
+  call get_command(length=i2)
+  !OK:
+  call get_command(length=i4)
+  !OK:
+  call get_command(length=i8)
+  !OK:
+  call get_command(length=i16)
+  !ERROR: Actual argument for 'length=' has bad type or kind 'INTEGER(1)'
+  call get_command_argument(number=a,length=i1)
+  !OK:
+  call get_command_argument(number=a,length=i2)
+  !OK:
+  call get_command_argument(number=a,length=i4)
+  !OK:
+  call get_command_argument(number=a,length=i8)
+  !OK:
+  call get_command_argument(number=a,length=i16)
+end program
\ No newline at end of file

[eugeneepshteyn]

I think Fortran spec actually agrees with this change for get_command_argument: "LENGTH (optional) shall be a scalar of type integer with a decimal exponent range of at least four." I read it is that it must be at least integer kind 2.