Skip to content

Conversation

klausler
Copy link
Contributor

When an external procedure is called by means of an implicit interface that turns out to be different in a significant way from the actual interface in its definition elsewhere in the source file, we emit an error message. This works for differences in actual vs dummy arguments, and for the result types of previously declared functions. This patch adds checking for differences between implicitly typed external function references and their actual declared types when the function's definition appears later.

When an external procedure is called by means of an implicit interface
that turns out to be different in a significant way from the actual
interface in its definition elsewhere in the source file, we emit
an error message.  This works for differences in actual vs dummy
arguments, and for the result types of previously declared functions.
This patch adds checking for differences between implicitly typed
external function references and their actual declared types when
the function's definition appears later.
@llvmbot llvmbot added flang Flang issues not falling into any other category flang:semantics labels Aug 26, 2025
@llvmbot
Copy link
Member

llvmbot commented Aug 26, 2025

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

When an external procedure is called by means of an implicit interface that turns out to be different in a significant way from the actual interface in its definition elsewhere in the source file, we emit an error message. This works for differences in actual vs dummy arguments, and for the result types of previously declared functions. This patch adds checking for differences between implicitly typed external function references and their actual declared types when the function's definition appears later.


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

2 Files Affected:

  • (modified) flang/lib/Semantics/resolve-names.cpp (+44-17)
  • (added) flang/test/Semantics/global02.f90 (+37)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5808b4b3cc4fe..6150f1853df64 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -488,6 +488,10 @@ class FuncResultStack {
     // Result symbol
     Symbol *resultSymbol{nullptr};
     bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt
+    // Functions with previous implicitly-typed references get those types
+    // checked against their later definitions.
+    const DeclTypeSpec *previousImplicitType{nullptr};
+    SourceName previousName;
   };
 
   // Completes the definition of the top function's result.
@@ -943,7 +947,7 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
   // Edits an existing symbol created for earlier calls to a subprogram or ENTRY
   // so that it can be replaced by a later definition.
   bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
-  void CheckExtantProc(const parser::Name &, Symbol::Flag);
+  const Symbol *CheckExtantProc(const parser::Name &, Symbol::Flag);
   // Create a subprogram symbol in the current scope and push a new scope.
   Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
       const parser::LanguageBindingSpec * = nullptr,
@@ -2691,11 +2695,17 @@ void ArraySpecVisitor::PostAttrSpec() {
 
 FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
 
+static bool TypesMismatchIfNonNull(
+    const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
+  return type1 && type2 && *type1 != *type2;
+}
+
 void FuncResultStack::CompleteFunctionResultType() {
   // If the function has a type in the prefix, process it now.
   FuncInfo *info{Top()};
-  if (info && &info->scope == &scopeHandler_.currScope()) {
-    if (info->parsedType && info->resultSymbol) {
+  if (info && &info->scope == &scopeHandler_.currScope() &&
+      info->resultSymbol) {
+    if (info->parsedType) {
       scopeHandler_.messageHandler().set_currStmtSource(info->source);
       if (const auto *type{
               scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
@@ -2712,6 +2722,16 @@ void FuncResultStack::CompleteFunctionResultType() {
       }
       info->parsedType = nullptr;
     }
+    if (TypesMismatchIfNonNull(
+            info->resultSymbol->GetType(), info->previousImplicitType)) {
+      scopeHandler_
+          .Say(info->resultSymbol->name(),
+              "Function '%s' has a result type that differs from the implicit type it obtained in a previous reference"_err_en_US,
+              info->previousName)
+          .Attach(info->previousName,
+              "Previous reference implicitly typed as %s\n"_en_US,
+              info->previousImplicitType->AsFortran());
+    }
   }
 }
 
@@ -4761,9 +4781,7 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   if (info.resultName && !distinctResultName) {
     context().Warn(common::UsageWarning::HomonymousResult,
         info.resultName->source,
-        "The function name should not appear in RESULT; references to '%s' "
-        "inside the function will be considered as references to the "
-        "result only"_warn_en_US,
+        "The function name should not appear in RESULT; references to '%s' inside the function will be considered as references to the result only"_warn_en_US,
         name.source);
     // RESULT name was ignored above, the only side effect from doing so will be
     // the inability to make recursive calls. The related parser::Name is still
@@ -5074,8 +5092,7 @@ bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
   if (hasModulePrefix && !currScope().IsModule() &&
       !currScope().IsSubmodule()) { // C1547
     Say(name,
-        "'%s' is a MODULE procedure which must be declared within a "
-        "MODULE or SUBMODULE"_err_en_US);
+        "'%s' is a MODULE procedure which must be declared within a MODULE or SUBMODULE"_err_en_US);
     // Don't return here because it can be useful to have the scope set for
     // other semantic checks run before we print the errors
     isValid = false;
@@ -5196,9 +5213,10 @@ bool SubprogramVisitor::HandlePreviousCalls(
   }
 }
 
-void SubprogramVisitor::CheckExtantProc(
+const Symbol *SubprogramVisitor::CheckExtantProc(
     const parser::Name &name, Symbol::Flag subpFlag) {
-  if (auto *prev{FindSymbol(name)}) {
+  Symbol *prev{FindSymbol(name)};
+  if (prev) {
     if (IsDummy(*prev)) {
     } else if (auto *entity{prev->detailsIf<EntityDetails>()};
                IsPointer(*prev) && entity && !entity->type()) {
@@ -5210,12 +5228,15 @@ void SubprogramVisitor::CheckExtantProc(
       SayAlreadyDeclared(name, *prev);
     }
   }
+  return prev;
 }
 
 Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
     Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
     bool hasModulePrefix) {
   Symbol *symbol{GetSpecificFromGeneric(name)};
+  const DeclTypeSpec *previousImplicitType{nullptr};
+  SourceName previousName;
   if (!symbol) {
     if (bindingSpec && currScope().IsGlobal() &&
         std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
@@ -5228,14 +5249,25 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
           &MakeSymbol(context().GetTempName(currScope()), Attrs{},
               MiscDetails{MiscDetails::Kind::ScopeName}));
     }
-    CheckExtantProc(name, subpFlag);
+    if (const Symbol *previous{CheckExtantProc(name, subpFlag)}) {
+      if (previous->test(Symbol::Flag::Function) &&
+          previous->test(Symbol::Flag::Implicit)) {
+        // Function was implicitly typed in previous compilation unit.
+        previousImplicitType = previous->GetType();
+        previousName = previous->name();
+      }
+    }
     symbol = &MakeSymbol(name, SubprogramDetails{});
   }
   symbol->ReplaceName(name.source);
   symbol->set(subpFlag);
   PushScope(Scope::Kind::Subprogram, symbol);
   if (subpFlag == Symbol::Flag::Function) {
-    funcResultStack().Push(currScope(), name.source);
+    auto &funcResultTop{funcResultStack().Push(currScope(), name.source)};
+    funcResultTop.previousImplicitType = previousImplicitType;
+    ;
+    funcResultTop.previousName = previousName;
+    ;
   }
   if (inInterfaceBlock()) {
     auto &details{symbol->get<SubprogramDetails>()};
@@ -8669,11 +8701,6 @@ const parser::Name *DeclarationVisitor::ResolveDataRef(
       x.u);
 }
 
-static bool TypesMismatchIfNonNull(
-    const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
-  return type1 && type2 && *type1 != *type2;
-}
-
 // If implicit types are allowed, ensure name is in the symbol table.
 // Otherwise, report an error if it hasn't been declared.
 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
diff --git a/flang/test/Semantics/global02.f90 b/flang/test/Semantics/global02.f90
new file mode 100644
index 0000000000000..505b3b06b1379
--- /dev/null
+++ b/flang/test/Semantics/global02.f90
@@ -0,0 +1,37 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Catch discrepancies between implicit result types and a global definition
+
+complex function zbefore()
+zbefore = (0.,0.)
+end
+
+program main
+!ERROR: Implicit declaration of function 'zbefore' has a different result type than in previous declaration
+print *, zbefore()
+print *, zafter()
+print *, zafter2()
+print *, zafter3()
+end
+
+subroutine another
+implicit integer(z)
+!ERROR: Implicit declaration of function 'zafter' has a different result type than in previous declaration
+print *, zafter()
+end
+
+!ERROR: Function 'zafter' has a result type that differs from the implicit type it obtained in a previous reference
+complex function zafter()
+zafter = (0.,0.)
+end
+
+function zafter2()
+!ERROR: Function 'zafter2' has a result type that differs from the implicit type it obtained in a previous reference
+complex zafter2
+zafter2 = (0.,0.)
+end
+
+function zafter3() result(res)
+!ERROR: Function 'zafter3' has a result type that differs from the implicit type it obtained in a previous reference
+complex res
+res = (0.,0.)
+end

@klausler klausler merged commit f19b807 into llvm:main Aug 29, 2025
11 of 12 checks passed
@klausler klausler deleted the bug1376 branch August 29, 2025 14:49
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:semantics flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

3 participants