[flang-commits] [flang] [flang] Fix USE merge for renamed ISO_FORTRAN_ENV COMPILER_* vs user generic (PR #217005)

[via flang-commits]

llvmorg-github-actions[bot] wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: ejose02

<details>
<summary>Changes</summary>

Issue : Flang rejected merging use-associated compiler_version/compiler_options (renamed to __builtin_* intrinsics) with a same-named user generic because DoAddUse compared ultimate symbol names, producing spurious "ambiguous" errors.

Fix : Compare local USE names for intrinsic+generic merge, record the intrinsic on the merged generic, and probe the intrinsic table when resolving calls on a generic whose same-name specific is intrinsic. Added a regression test.

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


3 Files Affected:

- (modified) flang/lib/Semantics/expression.cpp (+14-5) 
- (modified) flang/lib/Semantics/resolve-names.cpp (+7-2) 
- (added) flang/test/Semantics/compiler-version-generic.f90 (+50) 


``````````diff
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index fc57cc43e981c..0caf10796d5f5 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3188,22 +3188,31 @@ auto ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
     bool isSubroutine, SymbolVector &&tried, bool mightBeStructureConstructor)
     -> GenericResolution {
   const Symbol &ultimate{symbol.GetUltimate()};
-  // Check for a match with an explicit INTRINSIC
+  const auto *genericDetails{ultimate.detailsIf<semantics::GenericDetails>()};
   const Symbol *explicitIntrinsic{nullptr};
-  if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
+  auto probeIntrinsic{[&](const Symbol &intrinsic) {
     parser::Messages buffer;
     auto restorer{GetContextualMessages().SetMessages(buffer)};
     ActualArguments localActuals{actuals};
     if (context_.intrinsics().Probe(
-            CallCharacteristics{ultimate.name().ToString(), isSubroutine},
+            CallCharacteristics{intrinsic.name().ToString(), isSubroutine},
             localActuals, foldingContext_) &&
         !buffer.AnyFatalError()) {
-      explicitIntrinsic = &ultimate;
+      explicitIntrinsic = &intrinsic;
+    }
+  }};
+  if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
+    probeIntrinsic(ultimate);
+  } else if (genericDetails) {
+    if (const Symbol *sameNameSpecific{genericDetails->specific()}) {
+      const Symbol &specificUltimate{sameNameSpecific->GetUltimate()};
+      if (specificUltimate.attrs().test(semantics::Attr::INTRINSIC)) {
+        probeIntrinsic(specificUltimate);
+      }
     }
   }
   const Symbol *elemental{nullptr}; // matching elemental specific proc
   const Symbol *nonElemental{nullptr}; // matching non-elemental specific
-  const auto *genericDetails{ultimate.detailsIf<semantics::GenericDetails>()};
   if (genericDetails && !explicitIntrinsic) {
     std::optional<CudaMatchingDistance> crtMatchingDistance;
     for (const Symbol &specific0 : genericDetails->specificProcs()) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 27c4e96d269aa..2f8c218c6be2c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4481,8 +4481,8 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
     } else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {
       return; // nothing to do; used subprogram is local's specific
     } else if (useUltimate.attrs().test(Attr::INTRINSIC) &&
-        useUltimate.name() == localSymbol->name()) {
-      return; // local generic can extend intrinsic
+        useSymbol.name() == localSymbol->name()) {
+      // Fall through to merge the intrinsic into the generic.
     } else {
       for (const auto &ref : localGeneric->specificProcs()) {
         if (&ref->GetUltimate() == &useUltimate) {
@@ -4504,6 +4504,9 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
           UseDetails{localName, useUltimate})};
       newSymbol.flags() = useSymbol.flags();
       return;
+    } else if (localSymbol->attrs().test(Attr::INTRINSIC) &&
+        useSymbol.name() == localSymbol->name() &&
+        localUltimate.name() != useUltimate.name()) {
     } else {
       for (const auto &ref : useGeneric->specificProcs()) {
         if (&ref->GetUltimate() == &localUltimate) {
@@ -4581,6 +4584,8 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
           localGeneric->AddSpecificProc(useSpecific, useBindingName);
         }
       }
+    } else if (useUltimate.attrs().test(Attr::INTRINSIC)) {
+      AddGenericUse(*localGeneric, localName, useSymbol);
     }
     localGeneric->clear_derivedType();
     if (combinedDerivedType) {
diff --git a/flang/test/Semantics/compiler-version-generic.f90 b/flang/test/Semantics/compiler-version-generic.f90
new file mode 100644
index 0000000000000..89f29ce7cf955
--- /dev/null
+++ b/flang/test/Semantics/compiler-version-generic.f90
@@ -0,0 +1,50 @@
+! RUN: %flang_fc1 -fsyntax-only %s
+! Test merging USE of ISO_FORTRAN_ENV compiler_version/compiler_options
+! with a user generic of the same local name.
+
+module user_cv_co
+  interface compiler_version
+    module procedure okp
+  end interface
+  interface compiler_options
+    module procedure oko
+  end interface
+contains
+  function okp(f)
+    character(:), allocatable :: okp
+    logical, intent(in) :: f
+    okp = merge('user:ok  ', 'user:fail', f)
+  end function
+  function oko(f)
+    character(:), allocatable :: oko
+    logical, intent(in) :: f
+    oko = merge('opts:ok  ', 'opts:fail', f)
+  end function
+end module
+
+program compiler_version_generic_use
+  call order1()
+  call order2()
+contains
+  subroutine order1()
+    use iso_fortran_env, only: compiler_version, compiler_options
+    use user_cv_co
+    character(*), parameter :: bufv = compiler_version()
+    character(*), parameter :: bufo = compiler_options()
+    print *, bufv
+    print *, bufo
+    print *, compiler_version(.true.), ' or ', compiler_version(.false.)
+    print *, compiler_options(.true.), ' or ', compiler_options(.false.)
+  end subroutine
+
+  subroutine order2()
+    use user_cv_co
+    use iso_fortran_env, only: compiler_version, compiler_options
+    character(*), parameter :: bufv = compiler_version()
+    character(*), parameter :: bufo = compiler_options()
+    print *, bufv
+    print *, bufo
+    print *, compiler_version(.true.), ' or ', compiler_version(.false.)
+    print *, compiler_options(.true.), ' or ', compiler_options(.false.)
+  end subroutine
+end program

``````````

</details>


https://github.com/llvm/llvm-project/pull/217005