[flang-commits] [flang] [flang] handle fir.call in AliasAnalysis::getModRef (PR #117164)

via flang-commits flang-commits at lists.llvm.org
Tue Nov 26 00:24:53 PST 2024


https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/117164

>From c12869e010d892caf93d153c187db846ba995a9e Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 20 Nov 2024 07:55:00 -0800
Subject: [PATCH 1/3] [flang] add internal_assoc flag

---
 flang/include/flang/Lower/AbstractConverter.h |  5 ++++
 flang/include/flang/Lower/PFTBuilder.h        |  1 +
 .../flang/Optimizer/Dialect/FIRAttr.td        |  5 +++-
 flang/lib/Lower/Bridge.cpp                    | 12 +++++++++
 flang/lib/Lower/ConvertVariable.cpp           | 27 ++++++++++++++++++-
 .../HLFIR/assumed-rank-internal-proc.f90      |  6 ++---
 flang/test/Lower/HLFIR/cray-pointers.f90      |  4 +--
 .../test/Lower/HLFIR/internal-procedures.f90  | 24 ++++++++++++++++-
 .../threadprivate-host-association-2.f90      |  4 +--
 .../OpenMP/threadprivate-host-association.f90 |  4 +--
 10 files changed, 80 insertions(+), 12 deletions(-)

diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h
index daded9091780e2..583fa6fb215a7b 100644
--- a/flang/include/flang/Lower/AbstractConverter.h
+++ b/flang/include/flang/Lower/AbstractConverter.h
@@ -61,6 +61,7 @@ class SymMap;
 struct SymbolBox;
 namespace pft {
 struct Variable;
+struct FunctionLikeUnit;
 }
 
 using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
@@ -233,6 +234,10 @@ class AbstractConverter {
   virtual bool
   isRegisteredDummySymbol(Fortran::semantics::SymbolRef symRef) const = 0;
 
+  /// Returns the FunctionLikeUnit being lowered, if any.
+  virtual const Fortran::lower::pft::FunctionLikeUnit *
+  getCurrentFunctionUnit() const = 0;
+
   //===--------------------------------------------------------------------===//
   // Types
   //===--------------------------------------------------------------------===//
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 7f1b93c564b4c4..9b9d9febc190a9 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -693,6 +693,7 @@ struct FunctionLikeUnit : public ProgramUnit {
   /// Return the host associations for this function like unit. The list of host
   /// associations are kept in the host procedure.
   HostAssociations &getHostAssoc() { return hostAssociations; }
+  const HostAssociations &getHostAssoc() const { return hostAssociations; };
 
   LLVM_DUMP_METHOD void dump() const;
 
diff --git a/flang/include/flang/Optimizer/Dialect/FIRAttr.td b/flang/include/flang/Optimizer/Dialect/FIRAttr.td
index 4e84959a3b3e14..e3474da6685af8 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRAttr.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRAttr.td
@@ -32,14 +32,17 @@ def FIRpointer      : I32BitEnumAttrCaseBit<"pointer", 9>;
 def FIRtarget       : I32BitEnumAttrCaseBit<"target", 10>;
 def FIRvalue        : I32BitEnumAttrCaseBit<"value", 11>;
 def FIRvolatile     : I32BitEnumAttrCaseBit<"fortran_volatile", 12, "volatile">;
+// Used inside internal procedure to flag variables host associated from parent procedure.
 def FIRHostAssoc    : I32BitEnumAttrCaseBit<"host_assoc", 13>;
+// Used inside parent procedure to flag variables host associated in internal procedure.
+def FIRInternalAssoc    : I32BitEnumAttrCaseBit<"internal_assoc", 14>;
 
 def fir_FortranVariableFlagsEnum : I32BitEnumAttr<
     "FortranVariableFlagsEnum",
     "Fortran variable attributes",
     [FIRnoAttributes, FIRallocatable, FIRasynchronous, FIRbind_c, FIRcontiguous,
      FIRintent_in, FIRintent_inout, FIRintent_out, FIRoptional, FIRparameter,
-     FIRpointer, FIRtarget, FIRvalue, FIRvolatile, FIRHostAssoc]> {
+     FIRpointer, FIRtarget, FIRvalue, FIRvolatile, FIRHostAssoc, FIRInternalAssoc]> {
   let separator = ", ";
   let cppNamespace = "::fir";
   let printBitEnumPrimaryGroups = 1;
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 7f41742bf5e8b2..cbae6955e2a076 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -1058,6 +1058,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     return registeredDummySymbols.contains(sym);
   }
 
+  const Fortran::lower::pft::FunctionLikeUnit *
+  getCurrentFunctionUnit() const override final {
+    return currentFunctionUnit;
+  }
+
   void registerTypeInfo(mlir::Location loc,
                         Fortran::lower::SymbolRef typeInfoSym,
                         const Fortran::semantics::DerivedTypeSpec &typeSpec,
@@ -5595,6 +5600,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   /// Lower a procedure (nest).
   void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
     setCurrentPosition(funit.getStartingSourceLoc());
+    setCurrentFunctionUnit(&funit);
     for (int entryIndex = 0, last = funit.entryPointList.size();
          entryIndex < last; ++entryIndex) {
       funit.setActiveEntry(entryIndex);
@@ -5604,6 +5610,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       endNewFunction(funit);
     }
     funit.setActiveEntry(0);
+    setCurrentFunctionUnit(nullptr);
     for (Fortran::lower::pft::ContainedUnit &unit : funit.containedUnitList)
       if (auto *f = std::get_if<Fortran::lower::pft::FunctionLikeUnit>(&unit))
         lowerFunc(*f); // internal procedure
@@ -5967,12 +5974,17 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   /// Reset all registered dummy symbols.
   void resetRegisteredDummySymbols() { registeredDummySymbols.clear(); }
 
+  void setCurrentFunctionUnit(Fortran::lower::pft::FunctionLikeUnit *unit) {
+    currentFunctionUnit = unit;
+  }
+
   //===--------------------------------------------------------------------===//
 
   Fortran::lower::LoweringBridge &bridge;
   Fortran::evaluate::FoldingContext foldingContext;
   fir::FirOpBuilder *builder = nullptr;
   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
+  Fortran::lower::pft::FunctionLikeUnit *currentFunctionUnit = nullptr;
   Fortran::lower::SymMap localSymbols;
   Fortran::parser::CharBlock currentPosition;
   TypeInfoConverter typeInfoConverter;
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index cc51d5a9bb8daf..4e167dba30bfcf 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1670,6 +1670,25 @@ cuf::DataAttributeAttr Fortran::lower::translateSymbolCUFDataAttribute(
   return cuf::getDataAttribute(mlirContext, cudaAttr);
 }
 
+static bool
+isCapturedInInternalProcedure(Fortran::lower::AbstractConverter &converter,
+                              const Fortran::semantics::Symbol &sym) {
+  const Fortran::lower::pft::FunctionLikeUnit *funit =
+      converter.getCurrentFunctionUnit();
+  if (!funit || funit->getHostAssoc().empty())
+    return false;
+  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
+  // the internal procedure and flag it as captured.
+  if (const auto *equivSet = Fortran::semantics::FindEquivalenceSet(sym))
+    for (const Fortran::semantics::EquivalenceObject &eqObj : *equivSet)
+      if (funit->getHostAssoc().isAssociated(eqObj.symbol))
+        return true;
+  return false;
+}
+
 /// Map a symbol to its FIR address and evaluated specification expressions.
 /// Not for symbols lowered to fir.box.
 /// Will optionally create fir.declare.
@@ -1705,8 +1724,12 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
     if (len)
       lenParams.emplace_back(len);
     auto name = converter.mangleName(sym);
+    fir::FortranVariableFlagsEnum extraFlags = {};
+    if (isCapturedInInternalProcedure(converter, sym))
+      extraFlags = extraFlags | fir::FortranVariableFlagsEnum::internal_assoc;
     fir::FortranVariableFlagsAttr attributes =
-        Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
+        Fortran::lower::translateSymbolAttributes(builder.getContext(), sym,
+                                                  extraFlags);
     cuf::DataAttributeAttr dataAttr =
         Fortran::lower::translateSymbolCUFDataAttribute(builder.getContext(),
                                                         sym);
@@ -1793,6 +1816,8 @@ void Fortran::lower::genDeclareSymbol(
       !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     const mlir::Location loc = genLocation(converter, sym);
+    if (isCapturedInInternalProcedure(converter, sym))
+      extraFlags = extraFlags | fir::FortranVariableFlagsEnum::internal_assoc;
     // FIXME: Using the ultimate symbol for translating symbol attributes will
     // lead to situations where the VOLATILE/ASYNCHRONOUS attributes are not
     // propagated to the hlfir.declare (these attributes can be added when
diff --git a/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90 b/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90
index 690ceb64a03cf9..e46d21d915eb1f 100644
--- a/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90
+++ b/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90
@@ -17,7 +17,7 @@ subroutine internal()
 ! CHECK-LABEL:   func.func @_QPtest_assumed_rank(
 ! CHECK-SAME:                                    %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x"}) {
 ! CHECK:           %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
-! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QFtest_assumed_rankEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFtest_assumed_rankEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
 ! CHECK:           %[[VAL_3:.*]] = fir.alloca tuple<!fir.box<!fir.array<*:f32>>>
 ! CHECK:           %[[VAL_4:.*]] = arith.constant 0 : i32
 ! CHECK:           %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<tuple<!fir.box<!fir.array<*:f32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<*:f32>>>
@@ -55,7 +55,7 @@ subroutine internal()
 ! CHECK-LABEL:   func.func @_QPtest_assumed_rank_optional(
 ! CHECK-SAME:                                             %[[VAL_0:.*]]: !fir.class<!fir.array<*:none>> {fir.bindc_name = "x", fir.optional}) {
 ! CHECK:           %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
-! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest_assumed_rank_optionalEx"} : (!fir.class<!fir.array<*:none>>, !fir.dscope) -> (!fir.class<!fir.array<*:none>>, !fir.class<!fir.array<*:none>>)
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional, internal_assoc>, uniq_name = "_QFtest_assumed_rank_optionalEx"} : (!fir.class<!fir.array<*:none>>, !fir.dscope) -> (!fir.class<!fir.array<*:none>>, !fir.class<!fir.array<*:none>>)
 ! CHECK:           %[[VAL_3:.*]] = fir.alloca tuple<!fir.class<!fir.array<*:none>>>
 ! CHECK:           %[[VAL_4:.*]] = arith.constant 0 : i32
 ! CHECK:           %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<tuple<!fir.class<!fir.array<*:none>>>>, i32) -> !fir.ref<!fir.class<!fir.array<*:none>>>
@@ -107,7 +107,7 @@ subroutine internal()
 ! CHECK-LABEL:   func.func @_QPtest_assumed_rank_ptr(
 ! CHECK-SAME:                                        %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
 ! CHECK:           %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
-! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_assumed_rank_ptrEx"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>)
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer, internal_assoc>, uniq_name = "_QFtest_assumed_rank_ptrEx"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>)
 ! CHECK:           %[[VAL_3:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
 ! CHECK:           %[[VAL_4:.*]] = arith.constant 0 : i32
 ! CHECK:           %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
diff --git a/flang/test/Lower/HLFIR/cray-pointers.f90 b/flang/test/Lower/HLFIR/cray-pointers.f90
index ae903c8b44be7b..bb49977dd2227b 100644
--- a/flang/test/Lower/HLFIR/cray-pointers.f90
+++ b/flang/test/Lower/HLFIR/cray-pointers.f90
@@ -381,12 +381,12 @@ subroutine internal()
 ! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>>
 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFtest_craypointer_captureEn"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>)
 ! CHECK:           %[[VAL_3:.*]] = fir.alloca i64 {bindc_name = "cray_pointer", uniq_name = "_QFtest_craypointer_captureEcray_pointer"}
-! CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFtest_craypointer_captureEcray_pointer"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFtest_craypointer_captureEcray_pointer"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
 ! CHECK:           %[[VAL_5:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i32>
 ! CHECK:           %[[VAL_6:.*]] = arith.constant 0 : i32
 ! CHECK:           %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_5]], %[[VAL_6]] : i32
 ! CHECK:           %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_5]], %[[VAL_6]] : i32
-! CHECK:           %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] typeparams %[[VAL_8]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_craypointer_captureEcray_pointee"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, i32) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
+! CHECK:           %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] typeparams %[[VAL_8]] {fortran_attrs = #fir.var_attrs<pointer, internal_assoc>, uniq_name = "_QFtest_craypointer_captureEcray_pointee"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, i32) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
 ! CHECK:           %[[VAL_10:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
 ! CHECK:           %[[VAL_11:.*]] = fir.embox %[[VAL_10]] typeparams %[[VAL_8]] : (!fir.ptr<!fir.char<1,?>>, i32) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
 ! CHECK:           fir.store %[[VAL_11]] to %[[VAL_9]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
diff --git a/flang/test/Lower/HLFIR/internal-procedures.f90 b/flang/test/Lower/HLFIR/internal-procedures.f90
index f0df1a7f6e64f4..12d862bf316c3f 100644
--- a/flang/test/Lower/HLFIR/internal-procedures.f90
+++ b/flang/test/Lower/HLFIR/internal-procedures.f90
@@ -9,6 +9,9 @@ subroutine internal
   call takes_array(x)
 end subroutine
 end subroutine
+! CHECK-LABEL: func.func @_QPtest_explicit_shape_array(
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare {{.*}} {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFtest_explicit_shape_arrayEx"}
+
 ! CHECK-LABEL: func.func private @_QFtest_explicit_shape_arrayPinternal(
 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
@@ -27,6 +30,9 @@ subroutine internal
   call takes_array(x)
 end subroutine
 end subroutine
+! CHECK-LABEL: func.func @_QPtest_assumed_shape(
+! CHECK:    %[[VAL_1:.*]]:2 = hlfir.declare {{.*}} {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFtest_assumed_shapeEx"}
+
 ! CHECK-LABEL: func.func private @_QFtest_assumed_shapePinternal(
 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
@@ -64,7 +70,7 @@ subroutine internal()
 end subroutine
 ! CHECK-LABEL:   func.func @_QPtest_proc_pointer(
 ! CHECK-SAME:                                    %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>) {
-! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointerEp"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer, internal_assoc>, uniq_name = "_QFtest_proc_pointerEp"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
 ! CHECK:           %[[VAL_2:.*]] = fir.alloca tuple<!fir.ref<!fir.boxproc<() -> ()>>>
 ! CHECK:           %[[VAL_3:.*]] = arith.constant 0 : i32
 ! CHECK:           %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.ref<!fir.boxproc<() -> ()>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.boxproc<() -> ()>>>
@@ -79,3 +85,19 @@ subroutine internal()
 ! CHECK:           %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<!fir.boxproc<() -> ()>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.boxproc<() -> ()>>>
 ! CHECK:           %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<!fir.boxproc<() -> ()>>>
 ! CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {fortran_attrs = #fir.var_attrs<pointer, host_assoc>, uniq_name = "_QFtest_proc_pointerEp"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+
+
+! Verify that all equivalence members gets the internal_assoc flag set if one
+! of them is captured in an internal procedure.
+subroutine test_captured_equiv()
+  real :: x, y
+  equivalence(x,y)
+  call internal()
+contains
+subroutine internal()
+  y = 0.
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_captured_equiv() {
+! CHECK:  hlfir.declare %{{.*}} {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFtest_captured_equivEx"}
+! CHECK:  hlfir.declare %{{.*}} {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFtest_captured_equivEy"}
diff --git a/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90 b/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90
index a8d29baf74f220..546d4920042d79 100644
--- a/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90
+++ b/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90
@@ -5,10 +5,10 @@
 
 !CHECK: func.func @_QQmain() attributes {fir.bindc_name = "main"} {
 !CHECK:   %[[A:.*]] = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFEa"}
-!CHECK:   %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+!CHECK:   %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
 !CHECK:   %[[A_ADDR:.*]] = fir.address_of(@_QFEa) : !fir.ref<i32>
 !CHECK:   %[[TP_A:.*]] = omp.threadprivate %[[A_ADDR]] : !fir.ref<i32> -> !fir.ref<i32>
-!CHECK:   %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+!CHECK:   %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
 !CHECK:   fir.call @_QFPsub() fastmath<contract> : () -> ()
 !CHECK:   return
 !CHECK: }
diff --git a/flang/test/Lower/OpenMP/threadprivate-host-association.f90 b/flang/test/Lower/OpenMP/threadprivate-host-association.f90
index 096e510c19c690..4fd958ba3b68c9 100644
--- a/flang/test/Lower/OpenMP/threadprivate-host-association.f90
+++ b/flang/test/Lower/OpenMP/threadprivate-host-association.f90
@@ -5,9 +5,9 @@
 
 !CHECK: func.func @_QQmain() attributes {fir.bindc_name = "main"} {
 !CHECK:   %[[A:.*]] = fir.address_of(@_QFEa) : !fir.ref<i32>
-!CHECK:   %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+!CHECK:   %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
 !CHECK:   %[[TP_A:.*]] = omp.threadprivate %[[A_DECL]]#1 : !fir.ref<i32> -> !fir.ref<i32>
-!CHECK:   %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+!CHECK:   %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {fortran_attrs = #fir.var_attrs<internal_assoc>, uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
 !CHECK:   fir.call @_QFPsub() fastmath<contract> : () -> ()
 !CHECK:   return
 !CHECK: }

>From 84c95d6c816004abe6c01eb754688fb35a666ffc Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 20 Nov 2024 05:44:28 -0800
Subject: [PATCH 2/3] [flang] handle fir.call in getModRef

---
 .../flang/Optimizer/Analysis/AliasAnalysis.h  |  11 +-
 .../Dialect/FortranVariableInterface.td       |   7 +
 .../lib/Optimizer/Analysis/AliasAnalysis.cpp  | 111 +++++++++++++-
 flang/lib/Optimizer/Analysis/CMakeLists.txt   |   1 +
 .../lib/Optimizer/Transforms/AddAliasTags.cpp |   5 +-
 .../AliasAnalysis/gen_mod_ref_test.py         |  18 +++
 .../modref-call-after-inlining.fir            |  45 ++++++
 .../AliasAnalysis/modref-call-args.f90        |  62 ++++++++
 .../AliasAnalysis/modref-call-dummies.f90     |  53 +++++++
 .../AliasAnalysis/modref-call-equivalence.f90 |  34 +++++
 .../AliasAnalysis/modref-call-globals.f90     |  68 +++++++++
 .../modref-call-internal-proc.f90             | 135 ++++++++++++++++++
 .../AliasAnalysis/modref-call-locals.f90      |  52 +++++++
 .../AliasAnalysis/modref-call-not-fortran.fir |  25 ++++
 14 files changed, 614 insertions(+), 13 deletions(-)
 create mode 100755 flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-after-inlining.fir
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-args.f90
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-dummies.f90
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-equivalence.f90
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-globals.f90
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-locals.f90
 create mode 100644 flang/test/Analysis/AliasAnalysis/modref-call-not-fortran.fir

diff --git a/flang/include/flang/Optimizer/Analysis/AliasAnalysis.h b/flang/include/flang/Optimizer/Analysis/AliasAnalysis.h
index d9953f580f401d..e410831c0fc3eb 100644
--- a/flang/include/flang/Optimizer/Analysis/AliasAnalysis.h
+++ b/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
diff --git a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
index 926e00ca043407..0fe2e60a1a95cc 100644
--- a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
+++ b/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();
diff --git a/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp b/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp
index 0c2e37c4446aa0..cfe953dad24674 100644
--- a/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp
+++ b/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 bellows are based on Fortran semantics and only holds if this
+  // is a call to a procedure form 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
diff --git a/flang/lib/Optimizer/Analysis/CMakeLists.txt b/flang/lib/Optimizer/Analysis/CMakeLists.txt
index c000a9da99f871..1358219fd98d52 100644
--- a/flang/lib/Optimizer/Analysis/CMakeLists.txt
+++ b/flang/lib/Optimizer/Analysis/CMakeLists.txt
@@ -4,6 +4,7 @@ add_flang_library(FIRAnalysis
 
   DEPENDS
   FIRDialect
+  FIRSupport
   HLFIRDialect
   MLIRIR
   MLIROpenMPDialect
diff --git a/flang/lib/Optimizer/Transforms/AddAliasTags.cpp b/flang/lib/Optimizer/Transforms/AddAliasTags.cpp
index 8feba072cfea67..f1e70875de0ba7 100644
--- a/flang/lib/Optimizer/Transforms/AddAliasTags.cpp
+++ b/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());
diff --git a/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py b/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py
new file mode 100755
index 00000000000000..92a38f727fd80a
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py
@@ -0,0 +1,18 @@
+#!/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)
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-after-inlining.fir b/flang/test/Analysis/AliasAnalysis/modref-call-after-inlining.fir
new file mode 100644
index 00000000000000..c9dd03c95d7e87
--- /dev/null
+++ b/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
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-args.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-args.f90
new file mode 100644
index 00000000000000..5fc2b8143377b0
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-args.f90
@@ -0,0 +1,62 @@
+! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \
+! RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+! RUN:  --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s
+
+! Test fir.call modref when arguments are passed to the call. This focus
+! on the possibility of "direct" effects (taken via the arguments, and not
+! via some indirect access via global states).
+
+subroutine test_simple()
+  implicit none
+  real :: test_var_x, test_var_y
+  call test_effect_external(test_var_x)
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_simple"
+! CHECK: test_effect_external -> test_var_x#0: ModRef
+! CHECK: test_effect_external -> test_var_y#0: NoModRef
+
+subroutine test_equivalence()
+  implicit none
+  real :: test_var_x, test_var_y
+  equivalence(test_var_x, test_var_y)
+  call test_effect_external(test_var_x)
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_equivalence"
+! CHECK: test_effect_external -> test_var_x#0: ModRef
+! CHECK: test_effect_external -> test_var_y#0: ModRef
+
+subroutine test_pointer()
+  implicit none
+  real, target :: test_var_x, test_var_y
+  real, pointer :: p
+  p => test_var_x
+  call test_effect_external(p)
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_pointer"
+! CHECK: test_effect_external -> test_var_x#0: ModRef
+! TODO: test_var_y should be NoModRef, the alias analysis is currently very
+! conservative whenever pointer/allocatable descriptors are involved (mostly
+! because it needs to make sure it is dealing descriptors for POINTER/ALLOCATABLE
+! from the Fortran source and that it can apply language rules).
+! CHECK: test_effect_external -> test_var_y#0: ModRef
+
+subroutine test_array_1(test_var_x)
+  implicit none
+  real :: test_var_x(:), test_var_y
+  call test_effect_external(test_var_x(10))
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_array_1"
+! CHECK: test_effect_external -> test_var_x#0: ModRef
+! CHECK: test_effect_external -> test_var_y#0: NoModRef
+
+subroutine test_array_copy_in(test_var_x)
+  implicit none
+  real :: test_var_x(:), test_var_y
+  call test_effect_external_2(test_var_x)
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_array_copy_in"
+! CHECK: test_effect_external_2 -> test_var_x#0: ModRef
+! TODO: copy-in/out is currently badly understood by alias analysis, this
+! causes the modref analysis to think the argument may alias with anyting.
+! test_var_y should obviously be considered NoMoRef in the call.
+! CHECK: test_effect_external_2 -> test_var_y#0: ModRef
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-dummies.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-dummies.f90
new file mode 100644
index 00000000000000..a4c57cff70927f
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-dummies.f90
@@ -0,0 +1,53 @@
+! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \
+! RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+! RUN:  --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s
+
+! Test fir.call modref for dummy argument variables. This focus on
+! the possibility of indirect effects inside the call.
+
+module somemod
+  interface
+    subroutine may_capture(x)
+      real, target :: x
+    end subroutine
+    subroutine set_pointer(x)
+      real, pointer :: x
+    end subroutine
+  end interface
+end module
+
+subroutine test_dummy(test_var_x)
+  use somemod, only : may_capture
+  implicit none
+  real :: test_var_x
+  ! Capture is invalid after the call because test_var_xsaved does not have the
+  ! target attribute.
+  call may_capture(test_var_x)
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_dummy"
+! CHECK: test_effect_external -> test_var_x#0: NoModRef
+
+subroutine test_dummy_target(test_var_x_target)
+  use somemod, only : may_capture
+  implicit none
+  real, target :: test_var_x_target
+  call may_capture(test_var_x_target)
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_dummy_target"
+! CHECK: test_effect_external -> test_var_x_target#0: ModRef
+
+subroutine test_dummy_pointer(p)
+  use somemod, only : set_pointer
+  implicit none
+  real, pointer :: p
+  call set_pointer(p)
+  ! Use associated to test the pointer target address, no the
+  ! address of the pointer descriptor.
+  associate(test_var_p_target  => p)
+    call test_effect_external()
+  end associate
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_dummy_pointer"
+! CHECK: test_effect_external -> test_var_p_target#0: ModRef
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-equivalence.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-equivalence.f90
new file mode 100644
index 00000000000000..1bb2f7a66431f8
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-equivalence.f90
@@ -0,0 +1,34 @@
+! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \
+! RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+! RUN:  --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s
+
+! Test that mod ref effects for variables captured in internal procedures
+! propagate to all the variables they are in equivalence with.
+subroutine test_captured_equiv()
+  implicit none
+  real :: test_var_x , test_var_y, test_var_z
+  equivalence(test_var_x, test_var_y)
+  call test_effect_internal()
+contains
+subroutine test_effect_internal()
+  test_var_y = 0.
+end subroutine
+end subroutine
+
+! CHECK-LABEL: Testing : "_QPtest_captured_equiv"
+! CHECK: test_effect_internal -> test_var_x#0: ModRef
+! CHECK: test_effect_internal -> test_var_y#0: ModRef
+! CHECK: test_effect_internal -> test_var_z#0: NoModRef
+
+subroutine test_no_capture()
+  implicit none
+  real :: test_var_x , test_var_y
+  equivalence(test_var_x, test_var_y)
+  call test_effect_internal()
+contains
+subroutine test_effect_internal()
+end subroutine
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_no_capture"
+! CHECK: test_effect_internal -> test_var_x#0: NoModRef
+! CHECK: test_effect_internal -> test_var_y#0: NoModRef
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90
new file mode 100644
index 00000000000000..3d81bbfb9a86d0
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90
@@ -0,0 +1,68 @@
+! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \
+! RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+! RUN:  --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s
+
+! Test fir.call modref for global variables (module, saved, common).
+
+
+module somemod
+  implicit none
+  real :: test_var_xmod
+  interface
+    subroutine may_capture(x)
+      real, target :: x
+    end subroutine
+  end interface
+end module
+
+subroutine test_module
+  use somemod, only : test_var_xmod
+  implicit none
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_module"
+! CHECK: test_effect_external -> test_var_xmod#0: ModRef
+
+subroutine test_saved_local
+  use somemod, only : may_capture
+  implicit none
+  real, save :: test_var_xsaved
+  ! Capture is invalid after the call because test_var_xsaved does not have the
+  ! target attribute.
+  call may_capture(test_var_xsaved)
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_saved_local"
+! CHECK: test_effect_external -> test_var_xsaved#0: NoModRef
+
+subroutine test_saved_target
+  use somemod, only : may_capture
+  implicit none
+  real, save, target :: test_var_target_xsaved
+  call may_capture(test_var_target_xsaved)
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_saved_target"
+! CHECK: test_effect_external -> test_var_target_xsaved#0: ModRef
+
+subroutine test_saved_used_in_internal
+  implicit none
+  real, save :: test_var_saved_captured
+  call may_capture_procedure_pointer(internal)
+  call test_effect_external()
+contains
+  subroutine internal
+    test_var_saved_captured = 0.
+  end subroutine
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_saved_used_in_internal"
+! CHECK: test_effect_external -> test_var_saved_captured#0: ModRef
+
+subroutine test_common
+  implicit none
+  real :: test_var_x_common
+  common /comm/ test_var_x_common 
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_common"
+! CHECK: test_effect_external -> test_var_x_common#0: ModRef
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90
new file mode 100644
index 00000000000000..2d8f8071a3795a
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90
@@ -0,0 +1,135 @@
+! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \
+! RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+! RUN:  --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s
+
+! Test fir.call modref with internal procedures
+
+subroutine simple_modref_test(test_var_x)
+  implicit none
+  real :: test_var_x
+  call test_effect_internal()
+contains
+  subroutine test_effect_internal()
+    test_var_x = 0.
+  end subroutine
+end subroutine
+! CHECK-LABEL: Testing : "_QPsimple_modref_test"
+! CHECK: test_effect_internal -> test_var_x#0: ModRef
+
+subroutine simple_nomodref_test(test_var_x)
+  implicit none
+  real :: test_var_x
+  call test_effect_internal()
+contains
+  subroutine test_effect_internal()
+    call some_external()
+  end subroutine
+end subroutine
+! CHECK-LABEL: Testing : "_QPsimple_nomodref_test"
+! CHECK: test_effect_internal -> test_var_x#0: NoModRef
+
+! Test that effects on captured variable are propagated to associated variables
+! in associate construct.
+
+subroutine test_associate()
+  implicit none
+  real :: test_var_x(10)
+  associate (test_var_y=>test_var_x)
+    test_var_y = test_effect_internal()
+  end associate
+contains
+  function test_effect_internal() result(res)
+    real :: res(10)
+    res = test_var_x(10:1:-1)
+  end function
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_associate"
+! CHECK: test_effect_internal -> test_var_x#0: ModRef
+! CHECK: test_effect_internal -> test_var_y#0: ModRef
+
+! Test that captured variables are considered to be affected when calling
+! another internal function.
+subroutine effect_inside_internal()
+  implicit none
+  real :: test_var_x(10)
+  call internal_sub()
+contains
+  subroutine internal_sub
+    test_var_x = test_effect_internal_func()
+  end subroutine
+  function test_effect_internal_func() result(res)
+    real :: res(10)
+    res = test_var_x(10:1:-1)
+  end function
+end subroutine
+! CHECK-LABEL: Testing : "_QFeffect_inside_internalPinternal_sub"
+! CHECK: test_effect_internal_func -> test_var_x#0: ModRef
+
+! Test that captured variables are considered to be affected when calling
+! any procedure
+subroutine effect_inside_internal_2()
+  implicit none
+  real :: test_var_x(10)
+  call some_external_that_may_capture_procedure_pointer(capturing_internal_func)
+  call internal_sub()
+contains
+  subroutine internal_sub
+    test_var_x(1) = 0
+    call test_effect_external_func_may_use_captured_proc_pointer()
+  end subroutine
+  function capturing_internal_func() result(res)
+    real :: res(10)
+    res = test_var_x(10:1:-1)
+  end function
+end subroutine
+! CHECK-LABEL: Testing : "_QFeffect_inside_internal_2Pinternal_sub"
+! CHECK: test_effect_external_func_may_use_captured_proc_pointer -> test_var_x#0: ModRef
+
+module ifaces
+  interface
+    subroutine modify_pointer(p)
+      real, pointer :: p
+    end subroutine
+    subroutine modify_allocatable(p)
+      real, allocatable :: p
+    end subroutine
+  end interface
+end module
+
+! Test that descriptor address of captured pointer are considered modified
+! in internal call.
+subroutine test_pointer()
+  real, pointer :: test_var_pointer
+  call capture_internal(modify_pointer)
+  associate (test_var_pointer_target => test_var_pointer)
+    ! external may call internal via procedure pointer
+    call test_effect_external()
+  end associate
+contains
+  subroutine internal()
+    use ifaces, only : modify_pointer
+    call modify_pointer(test_var_pointer)
+  end subroutine
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_pointer"
+! CHECK: test_effect_external -> test_var_pointer#0: ModRef
+! CHECK: test_effect_external -> test_var_pointer_target#0: ModRef
+
+! Test that descriptor address of captured allocatable are considered modified
+! in internal calls.
+subroutine test_allocatable()
+  real, allocatable :: test_var_allocatable
+  call capture_internal(modify_allocatable)
+  associate (test_var_allocatable_target => test_var_allocatable)
+    ! external may call internal via procedure pointer
+    call test_effect_external()
+  end associate
+contains
+  subroutine internal()
+    use ifaces, only : modify_allocatable
+    call modify_allocatable(test_var_allocatable)
+  end subroutine
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_allocatable"
+! CHECK: test_effect_external -> test_var_allocatable#0: ModRef
+! CHECK: test_effect_external -> test_var_allocatable_target#0: ModRef
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-locals.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-locals.f90
new file mode 100644
index 00000000000000..3038d1a450b7ee
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-locals.f90
@@ -0,0 +1,52 @@
+! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \
+! RUN:  fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \
+! RUN:  --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s
+
+! Test fir.call modref for local variables.
+
+module somemod
+  interface
+    subroutine may_capture(x)
+      real, target :: x
+    end subroutine
+    subroutine set_pointer(x)
+      real, pointer :: x
+    end subroutine
+  end interface
+end module
+
+subroutine test_local
+  use somemod, only : may_capture
+  implicit none
+  real :: test_var_x
+  ! Capture is invalid after the call because test_var_xsaved does not have the
+  ! target attribute.
+  call may_capture(test_var_x)
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_local"
+! CHECK: test_effect_external -> test_var_x#0: NoModRef
+
+subroutine test_local_target
+  use somemod, only : may_capture
+  implicit none
+  real, target :: test_var_x_target
+  call may_capture(test_var_x_target)
+  call test_effect_external()
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_local_target"
+! CHECK: test_effect_external -> test_var_x_target#0: ModRef
+
+subroutine test_local_pointer
+  use somemod, only : set_pointer
+  implicit none
+  real, pointer :: p
+  call set_pointer(p)
+  ! Use associated to test the pointer target address, no the
+  ! address of the pointer descriptor.
+  associate(test_var_p_target  => p)
+    call test_effect_external()
+  end associate
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_local_pointer"
+! CHECK: test_effect_external -> test_var_p_target#0: ModRef
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-not-fortran.fir b/flang/test/Analysis/AliasAnalysis/modref-call-not-fortran.fir
new file mode 100644
index 00000000000000..1cae83fa4f2253
--- /dev/null
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-not-fortran.fir
@@ -0,0 +1,25 @@
+// 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 that fir.call modref is conservative when it cannot enusre it is
+// dealing with a Fortran user variable or a Fortran user procedure.
+
+// Function "unknown" is not known to be a Fortran procedure.
+func.func @_QPtest_unknown_call(%arg0: !fir.ref<f32> {fir.bindc_name = "x"}) {
+  %0 = fir.dummy_scope : !fir.dscope
+  %1:2 = hlfir.declare %arg0 dummy_scope %0 {test.ptr = "x", uniq_name = "_QFtest_unknown_callEx"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)
+  fir.call @unknown() {test.ptr = "unknown"} : () -> ()
+  return
+}
+func.func private @unknown()
+// CHECK-LABEL: Testing : "_QPtest_unknown_call"
+// CHECK: unknown -> x#0: ModRef
+
+// Address "unknown_var" cannot be related to a Fortran variable.
+func.func @_QPtest_unknown_var(%arg0: !fir.ref<f32>) attributes {test.ptr = "unknown_var"} {
+  fir.call @_QPfortran_procedure() {test.ptr = "fortran_procedure"}: () -> ()
+  return
+}
+func.func private @_QPfortran_procedure()
+// CHECK-LABEL: Testing : "_QPtest_unknown_var"
+// CHECK: fortran_procedure -> unknown_var.region0#0: ModRef

>From 29a6f42c8636bdd43387ee2d5ecc6d8c939b4f6a Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 22 Nov 2024 06:19:52 -0800
Subject: [PATCH 3/3] address PR comments

---
 flang/lib/Optimizer/Analysis/AliasAnalysis.cpp   |  4 ++--
 .../Analysis/AliasAnalysis/gen_mod_ref_test.py   | 16 ++++++++++++----
 .../AliasAnalysis/modref-call-globals.f90        | 14 ++++++++++++++
 .../AliasAnalysis/modref-call-internal-proc.f90  |  9 ++++++---
 4 files changed, 34 insertions(+), 9 deletions(-)

diff --git a/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp b/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp
index cfe953dad24674..2b24791d6c7c52 100644
--- a/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp
+++ b/flang/lib/Optimizer/Analysis/AliasAnalysis.cpp
@@ -371,8 +371,8 @@ static ModRefResult getCallModRef(fir::CallOp call, mlir::Value var) {
   // 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 bellows are based on Fortran semantics and only holds if this
-  // is a call to a procedure form the Fortran source and this is a variable
+  // 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.
diff --git a/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py b/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py
index 92a38f727fd80a..ce7d9b1700bf7e 100755
--- a/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py
+++ b/flang/test/Analysis/AliasAnalysis/gen_mod_ref_test.py
@@ -3,7 +3,7 @@
 """
  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_"
@@ -13,6 +13,14 @@
 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)
+    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)
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90
index 3d81bbfb9a86d0..695b38ed406a53 100644
--- a/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-globals.f90
@@ -45,6 +45,20 @@ subroutine test_saved_target
 ! CHECK-LABEL: Testing : "_QPtest_saved_target"
 ! CHECK: test_effect_external -> test_var_target_xsaved#0: ModRef
 
+subroutine test_saved_target_2
+  use somemod, only : may_capture
+  implicit none
+  real, save, target :: test_var_target_xsaved
+  ! Pointer associations made to SAVE variables remain valid after the
+  ! procedure exit, so it cannot be ruled out that the variable has been
+  ! captured in a previous call to `test_var_target_xsaved` even though the
+  ! call to `test_effect_external` appears first here.
+  call test_effect_external()
+  call may_capture(test_var_target_xsaved)
+end subroutine
+! CHECK-LABEL: Testing : "_QPtest_saved_target_2"
+! CHECK: test_effect_external -> test_var_target_xsaved#0: ModRef
+
 subroutine test_saved_used_in_internal
   implicit none
   real, save :: test_var_saved_captured
diff --git a/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90 b/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90
index 2d8f8071a3795a..2683880c7765c2 100644
--- a/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90
+++ b/flang/test/Analysis/AliasAnalysis/modref-call-internal-proc.f90
@@ -33,9 +33,9 @@ subroutine test_effect_internal()
 
 subroutine test_associate()
   implicit none
-  real :: test_var_x(10)
+  real :: test_var_x(10), test_var_a(10)
   associate (test_var_y=>test_var_x)
-    test_var_y = test_effect_internal()
+     test_var_a = test_effect_internal()
   end associate
 contains
   function test_effect_internal() result(res)
@@ -44,6 +44,7 @@ function test_effect_internal() result(res)
   end function
 end subroutine
 ! CHECK-LABEL: Testing : "_QPtest_associate"
+! CHECK: test_effect_internal -> test_var_a#0: NoModRef
 ! CHECK: test_effect_internal -> test_var_x#0: ModRef
 ! CHECK: test_effect_internal -> test_var_y#0: ModRef
 
@@ -55,7 +56,8 @@ subroutine effect_inside_internal()
   call internal_sub()
 contains
   subroutine internal_sub
-    test_var_x = test_effect_internal_func()
+    real :: test_var_y(10)
+    test_var_y = test_effect_internal_func()
   end subroutine
   function test_effect_internal_func() result(res)
     real :: res(10)
@@ -64,6 +66,7 @@ function test_effect_internal_func() result(res)
 end subroutine
 ! CHECK-LABEL: Testing : "_QFeffect_inside_internalPinternal_sub"
 ! CHECK: test_effect_internal_func -> test_var_x#0: ModRef
+! CHECK: test_effect_internal_func -> test_var_y#0: NoModRef
 
 ! Test that captured variables are considered to be affected when calling
 ! any procedure



More information about the flang-commits mailing list