[flang] catch implicit interface incompatibility with global scope symbol

[jeanPerier]

Summary

Previously, when calling a procedure implicitly for which a global scope
procedure symbol with the same name existed, semantics resolved the
procedure name in the call to the global symbol without checking that
the symbol interface was compatible with the implicit interface of the
call.
This could cause expression rewrite and lowering to later badly process
the implicit call assuming a different result type or an explicit
interface. This could lead to lowering crash in case the actual argument
were incompatible with the dummies from the explicit interface.

Emit errors in the following problematic cases:

• If the result type from the symbol did not match the one from the implicit interface.
• If the symbol requires an explicit interface.

This patch still allows calling an F77 like procedure with different
actual argument types than the one it was defined with because it is
correctly supported in lowering and is a feature in some program
(it is a pointer cast). The two cases that won't be accepted have
little chance to make much sense. Results returning ABIs may differ
depending on the return types, and function that requires explicit
interface usually requires descriptors or specific processing that
is incompatible with implicit interfaces.

Note that this patch is not making a deep analysis, and it will only
catch mistakes if a global symbol and an implicit interface are
involved. Cases where the user provided a conflicting explicit
interface would still require a pass after name resolution to study
conflicts more deeply. But these cases will not crash lowering or
trigger expression rewrite to do weird things.

[klausler]

Looks great! Thanks for looking into this problem.

flang/lib/Semantics/expression.cpp

std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
     parser::CharBlock callSite, const ProcedureDesignator &proc,
     ActualArguments &arguments) {
   auto chars{characteristics::Procedure::Characterize(
       proc, context_.foldingContext())};
   if (chars) {
     bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
     if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
       Say(callSite,
-          "References to the procedure '%s' require an explicit interface"_en_US,
+          "References to the procedure '%s' require an explicit interface"_err_en_US,
           DEREF(proc.GetSymbol()).name());
     }
     // Checks for ASSOCIATED() are done in intrinsic table processing
     bool procIsAssociated{false};
     if (const SpecificIntrinsic *
         specificIntrinsic{proc.GetSpecificIntrinsic()}) {
       if (specificIntrinsic->name == "associated") {
         procIsAssociated = true;

flang/lib/Semantics/resolve-names.cpp

if (Symbol * symbol{currScope().FindSymbol(name->source)}) {
           }
           ApplyImplicitRules(*symbol);
         }
       }
     }
   }
 }
 
+static bool IsLocallyImplicitGlobalSymbol(
+    const Symbol &symbol, const parser::Name &localName) {
+  return symbol.owner().IsGlobal() &&
+      (!symbol.scope() ||
+          !symbol.scope()->sourceRange().Contains(localName.source));
+}
+
+static bool TypesMismatchIfNonNull(
+    const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
+  return type1 && type2 && *type1 != *type2;
+}
+
 // Check and set the Function or Subroutine flag on symbol; false on error.
 bool ResolveNamesVisitor::SetProcFlag(
     const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
   if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
     SayWithDecl(
         name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
     return false;
   } else if (symbol.test(Symbol::Flag::Subroutine) &&
       flag == Symbol::Flag::Function) {
     SayWithDecl(
         name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);
     return false;
+  } else if (flag == Symbol::Flag::Function &&
+      IsLocallyImplicitGlobalSymbol(symbol, name) &&
+      TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) {
+    SayWithDecl(name, symbol,
+        "Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US);
+    return false;
   } else if (symbol.has<ProcEntityDetails>()) {
     symbol.set(flag); // in case it hasn't been set yet
     if (flag == Symbol::Flag::Function) {
       ApplyImplicitRules(symbol);
     }
     if (symbol.attrs().test(Attr::INTRINSIC)) {
       AcquireIntrinsicProcedureFlags(symbol);
     }

flang/test/Semantics/call24.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! 15.4.2.2. Test that errors are reported when an explicit interface
+! is not provided for an external procedure that requires an explicit
+! interface (the definition needs to be visible so that the compiler
+! can detect the violation).
+
+subroutine foo(a_pointer)
+  real, pointer :: a_pointer(:)
+end subroutine
+
+subroutine test()
+  real, pointer :: a_pointer(:)
+  real, pointer :: an_array(:)
+
+  ! This call would be allowed if the interface was explicit here,
+  ! but its handling with an implicit interface is different (no
+  ! descriptor involved, copy-in/copy-out...)
+
+  !ERROR: References to the procedure 'foo' require an explicit interface
+  call foo(a_pointer)
+
+  ! This call would be error if the interface was explicit here.
+
+  !ERROR: References to the procedure 'foo' require an explicit interface
+  call foo(an_array)
+end subroutine

flang/test/Semantics/resolve89.f90

 ! PRESENT, or SAME_TYPE_AS, every specification inquiry reference is a 
 ! constant expression, and the value does not depend on the value of a variable.
 impure function impureFunc()
   integer :: impureFunc
 
   impureFunc = 3
 end function impureFunc
 
-pure function pureFunc()
-  integer :: pureFunc
+pure function iPureFunc()
+  integer :: iPureFunc
 
-  pureFunc = 3
-end function pureFunc
+  iPureFunc = 3
+end function iPureFunc
 
 module m
   real, allocatable :: mVar
 end module m
 
 subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
 ! C750
   use m
! C750
   real, dimension(merge(1, 2, associated(pointerArg))) :: realVar2
   real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realVar3
   real, dimension(ioArg) :: realVar4
   real, dimension(merge(1, 2, present(optionalArg))) :: realVar5
 
   ! statement functions referenced below
   iVolatileStmtFunc() = 3 * volatileVar
   iImpureStmtFunc() = 3 * impureFunc()
-  iPureStmtFunc() = 3 * pureFunc()
+  iPureStmtFunc() = 3 * iPureFunc()
 
   ! This is OK
   real, dimension(merge(1, 2, allocated(mVar))) :: rVar
 
 
   integer :: var = 3
     !ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
   real, dimension(iVolatileStmtFunc()) :: arrayVarWithVolatile