[flang] Fix bogus message on internal subprogram with alternate return

[PeteSteinfeld]

Summary

Internal subprograms have explicit interfaces. If an internal subprogram has
an alternate return, we check its explicit interface. But our explicit
interface checking was not allowing for alternate returns.

I fixed this by checking to see if the dummy argument was an alternate return.
I also added the test altreturn06.f90.

[klausler]

I'm confused by this change. The call checking code that's been modified pertains to absent actual arguments; but alternate returns can't be optional and must have corresponding positional actual arguments.

[PeteSteinfeld]

In D94017#2477542, @klausler wrote:

I'm confused by this change. The call checking code that's been modified pertains to absent actual arguments; but alternate returns can't be optional and must have corresponding positional actual arguments.

The code is checking for how to handle the situation where the actual argument is missing. That's potentially the case for optional arguments, but it also happens for alternate returns. So new code is saying that it's OK for the actual argument to be missing if the dummy argument is an alternate return. Formerly, we emitted an error message when calling an internal subprogram with alternate returns.

[klausler]

In D94017#2477615, @PeteSteinfeld wrote:

In D94017#2477542, @klausler wrote:

I'm confused by this change. The call checking code that's been modified pertains to absent actual arguments; but alternate returns can't be optional and must have corresponding positional actual arguments.

The code is checking for how to handle the situation where the actual argument is missing. That's potentially the case for optional arguments, but it also happens for alternate returns. So new code is saying that it's OK for the actual argument to be missing if the dummy argument is an alternate return. Formerly, we emitted an error message when calling an internal subprogram with alternate returns.

But how can it be okay for the actual argument to be missing when the corresponding dummy argument is an alternate return?

[PeteSteinfeld]

But how can it be okay for the actual argument to be missing when the corresponding dummy argument is an alternate return?

I don't know. I'll investigate further ...

[PeteSteinfeld]

With Peter's guidance, I changed the definition of actual arguments to allow
for the value of a statement label and changed the code that processes actual
arguments to put the value of the label into the actual argument.

I also verified that we were already doing the semantic checking required for
alternate returns and added another test.

[klausler]

flang/lib/Semantics/expression.cpp

2868 ↗

(On Diff #314960)

This variable, and the code later that it enables, may no longer be needed; I'm not sure why it's there.

[PeteSteinfeld]

flang/lib/Semantics/expression.cpp

2868 ↗

(On Diff #314960)

It does seem wrong to create data that's never used.

@schweitz, as I understand things, the current lowering code gets the value of alternate return labels from the parse tree. Do you plan to change that once their available in the values of the ActualArgument?

Note that there are a couple of ways that this value is used. One is for the implementation of the function isAlternateReturn(). The other is that you can now dump out the value of the label in the actual argument if you dump it out.

[jeanPerier]

@schweitz, as I understand things, the current lowering code gets the value of alternate return labels from the parse tree. Do you plan to change that once their available in the values of the ActualArgument?

That would make sens IMHO.
Otherwise, the change you have should work OK with lowering, except for the ProcedureRef hasAlternateReturns that is now wrong and would make lowering fail (see inlined comment).

flang/include/flang/Evaluate/call.h

19 ↗

(On Diff #314960)

parse-tree.h is pretty big, have you seen any compile time increase with this include here ? If so, you could define Label in lib/Common/Fortran.h and use that here and in parse-tree.h to save the parse-tree.h include here.

flang/lib/Semantics/expression.cpp

2148 ↗

(On Diff #314960)

That part of the code is now wrong (since argument list now contains the labels). This will yield wrong lowering. You could replace it with a call to a helper like:

static bool HasAlternateReturns(const evaluate::ActualArguments &args) {
  for (const auto &arg : args) {
    if (arg && arg->isAlternateReturn()) {
      return true;
    }
  }
  return false;
}

and bool hasAlternateReturns{HasAlternateReturns(callee->arguments)};

2868 ↗

(On Diff #314960)

I also think isAltReturn is made useless by this change and could be removed.

[PeteSteinfeld]

Responding to Jean's comments.

[schweitz]

flang/lib/Semantics/expression.cpp

2148 ↗

(On Diff #314960)

Let me know if you'd like Val to look at this one, Jean.

[PeteSteinfeld]

flang/include/flang/Evaluate/call.h

19 ↗

(On Diff #314960)

Thanks, Jean. I'll do that.

[jeanPerier]

Looks good to me, thanks Pete.

flang/lib/Semantics/check-call.cpp

static parser::Messages CheckExplicitInterface(
   if (buffer.empty()) {
     int index{0};
     evaluate::FoldingContext localContext{context, messages};
     for (auto &actual : actuals) {
       const auto &dummy{proc.dummyArguments.at(index++)};
       if (actual) {
         CheckExplicitInterfaceArg(
             *actual, dummy, proc, localContext, scope, intrinsic);
-      } else if (!dummy.IsOptional()) {
+      } else if (!dummy.IsOptional() &&
+          !std::holds_alternative<characteristics::AlternateReturn>(dummy.u)) {
         if (dummy.name.empty()) {
           messages.Say(
               "Dummy argument #%d is not OPTIONAL and is not associated with "
               "an actual argument in this procedure reference"_err_en_US,
               index);
         } else {
           messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
                        "associated with an actual argument in this procedure "

flang/test/Semantics/altreturn06.f90

+! RUN: %S/test_errors.sh %s %t %f18
+! Test argument passing for internal and external subprograms
+! Both of the following are OK
+  call extSubprogram (*100)
+  call intSubprogram (*100)
+100 PRINT *,'First alternate return'
+contains
+  subroutine intSubprogram(*)
+    return(1)
+  end subroutine
+end