[flang] Add support for the IARGC and GETARG legacy intrinsics (#196425)

Adds semantic checking and lowering, along with semantic and lowering
tests for the legacy GNU intrinsics 'IARGC()' and 'GETARG(POS, VALUE)'.

Although these could just be added as aliases to the standard
COMMAND_ARGUMENT_COUNT and GET_COMMAND_ARGUMENT intrinsics, they were
implemented as separate intrinsics because of some semantic differences
between them:

* IARGC always returns INTEGER(4), whereas COMMAND_ARGUMENT_COUNT
returns a default INTEGER, which could have a different kind.
* GETARG has only two arguments, both of which are required.
* GETARG's POS argument accepts any integer type of width less than or
equal to the default integer kind, while GET_COMMAND_ARGUMENT only
accepts default integers.

Fixes #158438

flang/docs/Intrinsics.md

@@ -1545,3 +1545,58 @@ subroutine test
   call show_descriptor(a)
 end subroutine test
 ```
+
+### Non-Standard Intrinsics: IARGC
+
+#### Description
+`IARGC()` returns the number of arguments passed on the command line when the containing program was invoked.
+
+#### Usage and Info
+- **Standard:** GNU extension
+- **Class:** Function
+- **Syntax:** `RESULT = IARGC()`
+- **Arguments:**
+- **Return value:** The number of command line arguments, type `INTEGER(4)`
+
+#### Example
+```Fortran
+program example_iargc
+  integer :: n
+  n = iargc()
+  print *, "Argument count:", n
+end program
+```
+
+### Non-Standard Intrinsics: GETARG
+
+#### Description
+`GETARG(POS, VALUE)` retrieves the `POS`-th argument that was passed on the command line when the containing program was invoked.
+After `GETARG` returns, the `VALUE` argument holds the `POS`-th command line argument.
+If `VALUE` cannot hold the argument, the argument is truncated to fit in `VALUE`.
+If there are less than `POS` arguments specified at the command line, `VALUE` is filled with blanks.
+If `POS` = 0, `VALUE` is set to the name of the program (on systems that support this feature). 
+
+#### Usage and Info
+- **Standard:** GNU extension
+- **Class:** Subroutine
+- **Syntax:** `CALL GETARG(POS, VALUE)`
+
+#### Arguments
+
+|         |                                                                                |
+|---------|--------------------------------------------------------------------------------|
+| `POS`   | Shall be of type `INTEGER` of any kind; `POS` >= 0 |
+| `VALUE` | Shall be of type `CHARACTER` and of default kind. |
+
+#### Example
+```Fortran
+PROGRAM test_getarg
+  INTEGER :: i
+  CHARACTER(len=32) :: arg
+
+  DO i = 1, iargc()
+    CALL getarg(i, arg)
+    WRITE (*,*) arg
+  END DO
+END PROGRAM
+```

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -237,6 +237,7 @@ struct IntrinsicLibrary {
   mlir::Value genGetPID(mlir::Type resultType,
                         llvm::ArrayRef<mlir::Value> args);
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
+  void genGetarg(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genGetGID(mlir::Type resultType,
                         llvm::ArrayRef<mlir::Value> args);
@@ -248,6 +249,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genIargc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);

flang/lib/Evaluate/intrinsics.cpp

@@ -620,6 +620,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
         {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
         OperandUnsigned},
     {"iand", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
+    {"iargc", {}, TypePattern{IntType, KindCode::exactKind, 4}, Rank::scalar,
+        IntrinsicClass::transformationalFunction},
     {"ibclr", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}}, SameIntOrUnsigned},
     {"ibits", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}, {"len", AnyInt}},
         SameIntOrUnsigned},
@@ -1665,6 +1667,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
                 common::Intent::InOut}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {"getarg",
+        {{"pos", AnyInt, Rank::scalar, Optionality::required,
+             common::Intent::In},
+            {"value", DefaultChar, Rank::scalar, Optionality::required,
+                common::Intent::Out}},
+        {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"getcwd",
         {{"c", DefaultChar, Rank::scalar, Optionality::required,
              common::Intent::Out},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -368,6 +368,10 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genGetTeam,
      {{{"level", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"getarg",
+     &I::genGetarg,
+     {{{"pos", asValue}, {"value", asBox}}},
+     /*isElemental=*/false},
     {"getcwd",
      &I::genGetCwd,
      {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
@@ -393,6 +397,7 @@ static constexpr IntrinsicHandler handlers[]{
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"iargc", &I::genIargc},
     {"ibclr", &I::genIbclr},
     {"ibits", &I::genIbits},
     {"ibset", &I::genIbset},
@@ -4364,6 +4369,24 @@ void IntrinsicLibrary::genGetCommandArgument(
   }
 }
 
+// GETARG
+void IntrinsicLibrary::genGetarg(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 2);
+
+  mlir::Value pos = fir::getBase(args[0]);
+  mlir::Value value = fir::getBase(args[1]);
+
+  if (!pos)
+    fir::emitFatalError(loc, "expected POS parameter");
+
+  mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+  mlir::Value absentBox =
+      fir::AbsentOp::create(builder, loc, boxNoneTy).getResult();
+
+  fir::runtime::genGetCommandArgument(builder, loc, pos, value, absentBox,
+                                      absentBox);
+}
+
 // GET_ENVIRONMENT_VARIABLE
 void IntrinsicLibrary::genGetEnvironmentVariable(
     llvm::ArrayRef<fir::ExtendedValue> args) {
@@ -4556,6 +4579,15 @@ IntrinsicLibrary::genIany(mlir::Type resultType,
                       resultType, args);
 }
 
+// IARGC
+fir::ExtendedValue
+IntrinsicLibrary::genIargc(mlir::Type resultType,
+                           llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 0);
+  return builder.createConvert(
+      loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
+}
+
 // IBCLR
 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
                                        llvm::ArrayRef<mlir::Value> args) {

flang/test/Lower/Intrinsics/getarg.f90

@@ -0,0 +1,23 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-32 -DDEFAULT_INTEGER_SIZE=32 %s
+! RUN: %flang_fc1 -fdefault-integer-8 -emit-hlfir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-64 -DDEFAULT_INTEGER_SIZE=64 %s
+
+! CHECK-LABEL: func @_QPgetarg_test(
+! CHECK-SAME: %[[pos:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>{{.*}}, %[[value:.*]]: !fir.boxchar<1>{{.*}}) {
+subroutine getarg_test(pos, value)
+integer :: pos
+character(len=32) :: value
+call getarg(pos, value)
+! CHECK: %[[valueUnboxed:.*]]:2 = fir.unboxchar %[[value]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[valueCast:.*]] = fir.convert %[[valueUnboxed]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK: hlfir.declare %[[valueCast]]
+! CHECK: %[[posLoad:.*]] = fir.load {{.*}} : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
+! CHECK: %[[valueBoxed:.*]] = fir.embox {{.*}} : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK: %[[absent:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileLength:.*]]>>
+! CHECK: %[[sourceLine:.*]] = arith.constant [[# @LINE - 8]] : i32
+! CHECK-64: %[[posCast:.*]] = fir.convert %[[posLoad]] : (i[[DEFAULT_INTEGER_SIZE]]) -> i32
+! CHECK: %[[valueBoxedCast:.*]] = fir.convert %[[valueBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileLength]]>>) -> !fir.ref<i8>
+! CHECK-32: fir.call @_FortranAGetCommandArgument(%[[posLoad]], %[[valueBoxedCast]], %[[absent]], %[[absent]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (i32, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64: fir.call @_FortranAGetCommandArgument(%[[posCast]], %[[valueBoxedCast]], %[[absent]], %[[absent]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (i32, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+end subroutine getarg_test

flang/test/Lower/Intrinsics/iargc.f90

@@ -0,0 +1,11 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+! bbc doesn't have a way to set the default kinds so we use flang driver
+! RUN: %flang_fc1 -fdefault-integer-8 -emit-hlfir %s -o - | FileCheck --check-prefixes=CHECK %s
+
+! CHECK-LABEL: iargc_test
+subroutine iargc_test()
+integer(4) :: arg_count_test
+arg_count_test = iargc()
+! CHECK: %[[argumentCount:.*]] = fir.call @_FortranAArgumentCount() {{.*}}: () -> i32
+! CHECK: return
+end subroutine iargc_test

flang/test/Semantics/test-iargc-getarg.f90

@@ -0,0 +1,54 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+subroutine iargc_test
+  implicit none
+  integer :: n
+  integer(4) :: i4
+  character(32) :: value
+  !OK:
+  i4 = iargc()
+  !ERROR: Cannot call function 'iargc' like a subroutine
+  call iargc()
+end subroutine iargc_test
+
+subroutine getarg_test_1
+  implicit none
+  integer :: n
+  character(32) :: value
+  !OK:
+  call getarg(n, value)
+  !ERROR: Cannot call subroutine 'getarg' like a function
+  n = getarg(1, value)
+end subroutine getarg_test_1
+
+subroutine getarg_test_2
+  implicit none
+  integer :: n
+  character(32) :: value
+  !ERROR: No explicit type declared for 'getarg'
+  n = getarg(1, value)
+end subroutine getarg_test_2
+
+subroutine getarg_test_3
+  implicit none
+  integer :: n
+  real :: r
+  character(32) :: value
+  integer :: bad_value
+  !OK:
+  call getarg(n, value)
+  !ERROR: Actual argument for 'pos=' has bad type 'REAL(4)'
+  call getarg(r, value)
+  !ERROR: Actual argument for 'value=' has bad type 'INTEGER(4)'
+  call getarg(n, bad_value)
+end subroutine getarg_test_3
+
+subroutine getarg_test_4
+  implicit none
+  integer(2) :: n2
+  integer(8) :: n8
+  character(32) :: value
+  !OK:
+  call getarg(n2, value)
+  !OK:
+  call getarg(n8, value)
+end subroutine getarg_test_4