[flang] handle fir.call in AliasAnalysis::getModRef

flang/include/flang/Optimizer/Analysis/AliasAnalysis.h

@@ -129,7 +129,7 @@ struct AliasAnalysis {
       /// inlining happens an inlined fir.declare of the callee's
       /// dummy argument identifies the scope where the source
       /// may be treated as a dummy argument.
-      mlir::Value instantiationPoint;
+      mlir::Operation *instantiationPoint;
 
       /// Whether the source was reached following data or box reference
       bool isData{false};
@@ -146,6 +146,8 @@ struct AliasAnalysis {
     /// Have we lost precision following the source such that
     /// even an exact match cannot be MustAlias?
     bool approximateSource;
+    /// Source object is used in an internal procedure via host association.
+    bool isCapturedInInternalProcedure{false};
 
     /// Print information about the memory source to `os`.
     void print(llvm::raw_ostream &os) const;
@@ -157,6 +159,9 @@ struct AliasAnalysis {
     bool isData() const;
     bool isBoxData() const;
 
+    /// Is this source a variable from the Fortran source?
+    bool isFortranUserVariable() const;
+
     /// @name Dummy Argument Aliasing
     ///
     /// Check conditions related to dummy argument aliasing.
@@ -194,11 +199,11 @@ struct AliasAnalysis {
   mlir::ModRefResult getModRef(mlir::Operation *op, mlir::Value location);
 
   /// Return the memory source of a value.
-  /// If getInstantiationPoint is true, the search for the source
+  /// If getLastInstantiationPoint is true, the search for the source
   /// will stop at [hl]fir.declare if it represents a dummy
   /// argument declaration (i.e. it has the dummy_scope operand).
   fir::AliasAnalysis::Source getSource(mlir::Value,
-                                       bool getInstantiationPoint = false);
+                                       bool getLastInstantiationPoint = false);
 
 private:
   /// Return true, if `ty` is a reference type to an object of derived type

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td

@@ -184,6 +184,13 @@ def fir_FortranVariableOpInterface : OpInterface<"FortranVariableOpInterface"> {
                         fir::FortranVariableFlagsEnum::target);
     }
 
+    /// Is this variable captured in an internal procedure via Fortran host association?
+    bool isCapturedInInternalProcedure() {
+      auto attrs = getFortranAttrs();
+      return attrs && bitEnumContainsAny(*attrs,
+                        fir::FortranVariableFlagsEnum::internal_assoc);
+    }
+
     /// Is this variable a Fortran intent(in)?
     bool isIntentIn() {
       auto attrs = getFortranAttrs();

flang/lib/Lower/ConvertVariable.cpp

@@ -1680,7 +1680,9 @@ isCapturedInInternalProcedure(Fortran::lower::AbstractConverter &converter,
   if (funit->getHostAssoc().isAssociated(sym))
     return true;
   // Consider that any capture of a variable that is in an equivalence with the
+  // symbol imply that the storage of the symbol may also be accessed inside
   // symbol implies that the storage of the symbol may also be accessed inside
+
   // the internal procedure and flag it as captured.
   if (const auto *equivSet = Fortran::semantics::FindEquivalenceSet(sym))
     for (const Fortran::semantics::EquivalenceObject &eqObj : *equivSet)

flang/lib/Optimizer/Analysis/AliasAnalysis.cpp

@@ -12,6 +12,7 @@
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Dialect/FortranVariableInterface.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "flang/Optimizer/Support/InternalNames.h"
 #include "mlir/Analysis/AliasAnalysis.h"
 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
 #include "mlir/Dialect/OpenMP/OpenMPInterfaces.h"
@@ -96,6 +97,17 @@ bool AliasAnalysis::Source::isBoxData() const {
          origin.isData;
 }
 
+bool AliasAnalysis::Source::isFortranUserVariable() const {
+  if (!origin.instantiationPoint)
+    return false;
+  return llvm::TypeSwitch<mlir::Operation *, bool>(origin.instantiationPoint)
+      .template Case<fir::DeclareOp, hlfir::DeclareOp>([&](auto declOp) {
+        return fir::NameUniquer::deconstruct(declOp.getUniqName()).first ==
+               fir::NameUniquer::NameKind::VARIABLE;
+      })
+      .Default([&](auto op) { return false; });
+}
+
 bool AliasAnalysis::Source::mayBeDummyArgOrHostAssoc() const {
   return kind != SourceKind::Allocate && kind != SourceKind::Global;
 }
@@ -329,14 +341,92 @@ AliasResult AliasAnalysis::alias(Source lhsSrc, Source rhsSrc, mlir::Value lhs,
 // AliasAnalysis: getModRef
 //===----------------------------------------------------------------------===//
 
+static bool isSavedLocal(const fir::AliasAnalysis::Source &src) {
+  if (auto symRef = llvm::dyn_cast<mlir::SymbolRefAttr>(src.origin.u)) {
+    auto [nameKind, deconstruct] =
+        fir::NameUniquer::deconstruct(symRef.getLeafReference().getValue());
+    return nameKind == fir::NameUniquer::NameKind::VARIABLE &&
+           !deconstruct.procs.empty();
+  }
+  return false;
+}
+
+static bool isCallToFortranUserProcedure(fir::CallOp call) {
+  // TODO: indirect calls are excluded by these checks. Maybe some attribute is
+  // needed to flag user calls in this case.
+  if (fir::hasBindcAttr(call))
+    return true;
+  if (std::optional<mlir::SymbolRefAttr> callee = call.getCallee())
+    return fir::NameUniquer::deconstruct(callee->getLeafReference().getValue())
+               .first == fir::NameUniquer::NameKind::PROCEDURE;
+  return false;
+}
+
+static ModRefResult getCallModRef(fir::CallOp call, mlir::Value var) {
+  // TODO: limit to Fortran functions??
+  // 1. Detect variables that can be accessed indirectly.
+  fir::AliasAnalysis aliasAnalysis;
+  fir::AliasAnalysis::Source varSrc = aliasAnalysis.getSource(var);
+  // If the variable is not a user variable, we cannot safely assume that
+  // Fortran semantics apply (e.g., a bare alloca/allocmem result may very well
+  // be placed in an allocatable/pointer descriptor and escape).
+
+  // All the logic below is based on Fortran semantics and only holds if this
+  // is a call to a procedure from the Fortran source and this is a variable
+  // from the Fortran source. Compiler generated temporaries or functions may
+  // not adhere to this semantic.
+  // TODO: add some opt-in or op-out mechanism for compiler generated temps.
+  // An example of something currently problematic is the allocmem generated for
+  // ALLOCATE of allocatable target. It currently does not have the target
+  // attribute, which would lead this analysis to believe it cannot escape.
+  if (!varSrc.isFortranUserVariable() || !isCallToFortranUserProcedure(call))
+    return ModRefResult::getModAndRef();
+  // Pointer and target may have been captured.
+  if (varSrc.isTargetOrPointer())
+    return ModRefResult::getModAndRef();
+  // Host associated variables may be addressed indirectly via an internal
+  // function call, whether the call is in the parent or an internal procedure.
+  // Note that the host associated/internal procedure may be referenced
+  // indirectly inside calls to non internal procedure. This is because internal
+  // procedures may be captured or passed. As this is tricky to analyze, always
+  // consider such variables may be accessed in any calls.
+  if (varSrc.kind == fir::AliasAnalysis::SourceKind::HostAssoc ||
+      varSrc.isCapturedInInternalProcedure)
+    return ModRefResult::getModAndRef();
+  // At that stage, it has been ruled out that local (including the saved ones)
+  // and dummy cannot be indirectly accessed in the call.
+  if (varSrc.kind != fir::AliasAnalysis::SourceKind::Allocate &&
+      !varSrc.isDummyArgument()) {
+    if (varSrc.kind != fir::AliasAnalysis::SourceKind::Global ||
+        !isSavedLocal(varSrc))
+      return ModRefResult::getModAndRef();
+  }
+  // 2. Check if the variable is passed via the arguments.
+  for (auto arg : call.getArgs()) {
+    if (fir::conformsWithPassByRef(arg.getType()) &&
+        !aliasAnalysis.alias(arg, var).isNo()) {
+      // TODO: intent(in) would allow returning Ref here. This can be obtained
+      // in the func.func attributes for direct calls, but the module lookup is
+      // linear with the number of MLIR symbols, which would introduce a pseudo
+      // quadratic behavior num_calls * num_func.
+      return ModRefResult::getModAndRef();
+    }
+  }
+  // The call cannot access the variable.
+  return ModRefResult::getNoModRef();
+}
+
 /// This is mostly inspired by MLIR::LocalAliasAnalysis with 2 notable
 /// differences 1) Regions are not handled here but will be handled by a data
 /// flow analysis to come 2) Allocate and Free effects are considered
 /// modifying
 ModRefResult AliasAnalysis::getModRef(Operation *op, Value location) {
   MemoryEffectOpInterface interface = dyn_cast<MemoryEffectOpInterface>(op);
-  if (!interface)
+  if (!interface) {
+    if (auto call = llvm::dyn_cast<fir::CallOp>(op))
+      return getCallModRef(call, location);
     return ModRefResult::getModAndRef();
+  }
 
   // Build a ModRefResult by merging the behavior of the effects of this
   // operation.
@@ -408,19 +498,20 @@ static Value getPrivateArg(omp::BlockArgOpenMPOpInterface &argIface,
 }
 
 AliasAnalysis::Source AliasAnalysis::getSource(mlir::Value v,
-                                               bool getInstantiationPoint) {
+                                               bool getLastInstantiationPoint) {
   auto *defOp = v.getDefiningOp();
   SourceKind type{SourceKind::Unknown};
   mlir::Type ty;
   bool breakFromLoop{false};
   bool approximateSource{false};
+  bool isCapturedInInternalProcedure{false};
   bool followBoxData{mlir::isa<fir::BaseBoxType>(v.getType())};
   bool isBoxRef{fir::isa_ref_type(v.getType()) &&
                 mlir::isa<fir::BaseBoxType>(fir::unwrapRefType(v.getType()))};
   bool followingData = !isBoxRef;
   mlir::SymbolRefAttr global;
   Source::Attributes attributes;
-  mlir::Value instantiationPoint;
+  mlir::Operation *instantiationPoint{nullptr};
   while (defOp && !breakFromLoop) {
     ty = defOp->getResultTypes()[0];
     llvm::TypeSwitch<Operation *>(defOp)
@@ -548,6 +639,8 @@ AliasAnalysis::Source AliasAnalysis::getSource(mlir::Value v,
           // is the only carrier of the variable attributes,
           // so we have to collect them here.
           attributes |= getAttrsFromVariable(varIf);
+          isCapturedInInternalProcedure |=
+              varIf.isCapturedInInternalProcedure();
           if (varIf.isHostAssoc()) {
             // Do not track past such DeclareOp, because it does not
             // currently provide any useful information. The host associated
@@ -561,10 +654,10 @@ AliasAnalysis::Source AliasAnalysis::getSource(mlir::Value v,
             breakFromLoop = true;
             return;
           }
-          if (getInstantiationPoint) {
+          if (getLastInstantiationPoint) {
             // Fetch only the innermost instantiation point.
             if (!instantiationPoint)
-              instantiationPoint = op->getResult(0);
+              instantiationPoint = op;
 
             if (op.getDummyScope()) {
               // Do not track past DeclareOp that has the dummy_scope
@@ -575,6 +668,8 @@ AliasAnalysis::Source AliasAnalysis::getSource(mlir::Value v,
               breakFromLoop = true;
               return;
             }
+          } else {
+            instantiationPoint = op;
           }
           // TODO: Look for the fortran attributes present on the operation
           // Track further through the operand
@@ -620,13 +715,15 @@ AliasAnalysis::Source AliasAnalysis::getSource(mlir::Value v,
             type,
             ty,
             attributes,
-            approximateSource};
+            approximateSource,
+            isCapturedInInternalProcedure};
   }
   return {{v, instantiationPoint, followingData},
           type,
           ty,
           attributes,
-          approximateSource};
+          approximateSource,
+          isCapturedInInternalProcedure};
 }
 
 } // namespace fir

flang/lib/Optimizer/Analysis/CMakeLists.txt

@@ -4,6 +4,7 @@ add_flang_library(FIRAnalysis
 
   DEPENDS
   FIRDialect
+  FIRSupport
   HLFIRDialect
   MLIRIR
   MLIROpenMPDialect

flang/lib/Optimizer/Transforms/AddAliasTags.cpp

@@ -209,12 +209,11 @@ void AddAliasTagsPass::runOnAliasInterface(fir::FirAliasTagOpInterface op,
   state.processFunctionScopes(func);
 
   fir::DummyScopeOp scopeOp;
-  if (auto declVal = source.origin.instantiationPoint) {
+  if (auto declOp = source.origin.instantiationPoint) {
     // If the source is a dummy argument within some fir.dummy_scope,
     // then find the corresponding innermost scope to be used for finding
     // the right TBAA tree.
-    auto declareOp =
-        mlir::dyn_cast_or_null<fir::DeclareOp>(declVal.getDefiningOp());
+    auto declareOp = mlir::dyn_cast<fir::DeclareOp>(declOp);
     assert(declareOp && "Instantiation point must be fir.declare");
     if (auto dummyScope = declareOp.getDummyScope())
       scopeOp = mlir::cast<fir::DummyScopeOp>(dummyScope.getDefiningOp());

flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py

@@ -0,0 +1,26 @@
+#!/usr/bin/env python3
+
+"""
+ Add attributes hook in an HLFIR code to test fir.call ModRef effects
+ with the test-fir-alias-analysis-modref pass.
+
+ This will insert mod ref test hook:
+   - to any fir.call to a function which name starts with "test_effect_"
+   - to any hlfir.declare for variable which name starts with "test_var_"
+"""
+
+import sys
+import re
+
+for line in sys.stdin:
+    line = re.sub(
+        r"(fir.call @_\w*P)(test_effect_\w*)(\(.*) : ",
+        r'\1\2\3 {test.ptr ="\2"} : ',
+        line,
+    )
+    line = re.sub(
+        r'(hlfir.declare .*uniq_name =.*E)(test_var_\w*)"',
+        r'\1\2", test.ptr ="\2"',
+        line,
+    )
+    sys.stdout.write(line)

flang/test/Analysis/AliasAnalysis/modref-call-after-inlining.fir

@@ -0,0 +1,45 @@
+// RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+// RUN:  --mlir-disable-threading %s -o /dev/null 2>&1 | FileCheck %s
+
+// Test fir.call modref with internal procedures after the host function has been inlined in
+// some other function. This checks that the last hlfir.declare "internal_assoc" flags that
+// marks a variable that was captured is still considered even though there is no such flags
+// on the declare at the top of the chain.
+//
+// In other words, in the following Fortran example, "x" should be considered
+// modified by "call internal_proc" after "call inline_me" was inlined into
+// "test".
+//
+//    subroutine test()
+//      real :: x(10)
+//      call inline_me(x)
+//    end subroutine
+//    
+//    subroutine inline_me(x)
+//      real :: x(10)
+//      call internal_proc()
+//    contains
+//      subroutine internal_proc()
+//        call some_external(x)
+//      end subroutine
+//    end subroutine
+
+func.func @_QPtest() {                                                                 
+  %c0_i32 = arith.constant 0 : i32                                                     
+  %c10 = arith.constant 10 : index                                                     
+  %0 = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtestEx"}       
+  %1 = fir.shape %c10 : (index) -> !fir.shape<1>                                       
+  %2:2 = hlfir.declare %0(%1) {uniq_name = "_QFtestEx"} : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.array<10xf32>>)
+  %3 = fir.dummy_scope : !fir.dscope
+  %4:2 = hlfir.declare %2#1(%1) dummy_scope %3 {test.ptr = "x", fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFinline_meEx"} : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.array<10xf32>>)
+  %5 = fir.alloca tuple<!fir.box<!fir.array<10xf32>>>
+  %6 = fir.coordinate_of %5, %c0_i32 : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
+  %7 = fir.embox %4#1(%1) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>
+  fir.store %7 to %6 : !fir.ref<!fir.box<!fir.array<10xf32>>>                          
+  fir.call @_QFinline_mePinternal_proc(%5) {test.ptr="internal_proc"} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>>>) -> ()
+  return
+} 
+func.func private @_QFinline_mePinternal_proc(!fir.ref<tuple<!fir.box<!fir.array<10xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = @_QPinline_me}
+
+// CHECK-LABEL: Testing : "_QPtest"
+// CHECK: internal_proc -> x#0: ModRef