[flang-commits] [flang] [flang][Semantics] Introduce `-Wpass-global-variable` warning (PR #160324)

via flang-commits flang-commits at lists.llvm.org
Wed Oct 8 00:31:00 PDT 2025


https://github.com/foxtran updated https://github.com/llvm/llvm-project/pull/160324

>From a1f89bb882abd2491682d99c5fc639f897e727e8 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 23 Sep 2025 16:20:05 +0200
Subject: [PATCH 01/15] Implement -Wpass-global-variable flag for flang

---
 flang/include/flang/Support/Fortran-features.h | 2 +-
 flang/lib/Support/Fortran-features.cpp         | 1 +
 flang/unittests/Common/FortranFeaturesTest.cpp | 3 +++
 3 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 51364d552be64..494995e8844b6 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -79,7 +79,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     CompatibleDeclarationsFromDistinctModules, ConstantIsContiguous,
     NullActualForDefaultIntentAllocatable, UseAssociationIntoSameNameSubprogram,
     HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile,
-    RealConstantWidening, VolatileOrAsynchronousTemporary)
+    RealConstantWidening, VolatileOrAsynchronousTemporary, PassGlobalVariable)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index 4a6fb8d75a135..bb5c7b56634e8 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -149,6 +149,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnUsage_.set(UsageWarning::HostAssociatedIntentOutInSpecExpr);
   warnUsage_.set(UsageWarning::NonVolatilePointerToVolatile);
   warnUsage_.set(UsageWarning::RealConstantWidening);
+  warnUsage_.set(UsageWarning::PassGlobalVariable);
   // New warnings, on by default
   warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
   warnLanguage_.set(LanguageFeature::NullActualForAllocatable);
diff --git a/flang/unittests/Common/FortranFeaturesTest.cpp b/flang/unittests/Common/FortranFeaturesTest.cpp
index 9408da0361e1d..72946f5cb316b 100644
--- a/flang/unittests/Common/FortranFeaturesTest.cpp
+++ b/flang/unittests/Common/FortranFeaturesTest.cpp
@@ -556,6 +556,9 @@ TEST(FortranFeaturesTest, CamelCaseToLowerCaseHyphenated) {
   EXPECT_EQ(CamelCaseToLowerCaseHyphenated(
                 EnumToString(UsageWarning::NonVolatilePointerToVolatile)),
       "non-volatile-pointer-to-volatile");
+  EXPECT_EQ(CamelCaseToLowerCaseHyphenated(
+                EnumToString(UsageWarning::PassGlobalVariable)),
+      "pass-global-variable");
 }
 
 TEST(FortranFeaturesTest, HintLanguageControlFlag) {

>From 6dbb895f3fb34a5391af08d58618b45259fa0c48 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 23 Sep 2025 16:28:52 +0200
Subject: [PATCH 02/15] Add test for -Wpass-global-variable

---
 .../Semantics/pass-global-variables01.f90     | 169 ++++++++++++++++++
 1 file changed, 169 insertions(+)
 create mode 100644 flang/test/Semantics/pass-global-variables01.f90

diff --git a/flang/test/Semantics/pass-global-variables01.f90 b/flang/test/Semantics/pass-global-variables01.f90
new file mode 100644
index 0000000000000..d373b43489fe9
--- /dev/null
+++ b/flang/test/Semantics/pass-global-variables01.f90
@@ -0,0 +1,169 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1 -Werror -Wpass-global-variable
+module explicit_test_mod
+  implicit none (type, external)
+  integer :: i1
+  integer :: i2(1)
+  integer :: i3(3)
+  integer, allocatable :: ia(:)
+
+  real :: x1, y1
+  real :: x2, y2
+  real :: z, z2
+  common /xy1/ x1, y1(1)
+  common /xy2/ x2(1), y2
+  common /fm/ z(1)
+  common /fm_bad/ z2(5)
+contains
+  subroutine pass_int(i)
+    integer, intent(inout) :: i
+  end subroutine pass_int
+  subroutine pass_int_1d(i)
+    integer, intent(inout) :: i(*)
+  end subroutine pass_int_1d
+  subroutine pass_real(r)
+    real, intent(inout) :: r
+  end subroutine pass_real
+  subroutine pass_real_1d(r)
+    real, intent(inout) :: r(*)
+  end subroutine pass_real_1d
+  subroutine explicit_test(n)
+    integer, intent(in) :: n
+
+    !WARNING: Passing global variable 'i1' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+    call pass_int(i1)               !< warn:    basic type
+    call pass_int(i2(1))            !< ok:      shape == [1]
+    call pass_int(i2(n))            !< ok:      shape == [1]
+    !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+    call pass_int(i3(1))            !< warn:    shape /= [1]
+    !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+    call pass_int(i3(n))            !< warn:    shape /= [1]
+    !WARNING: Passing global variable 'i2' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+    call pass_int_1d(i2)            !< warn:    whole array is passed
+    call pass_int_1d(i2(n:n+3))     !< ok:      subrange of array
+    !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+    call pass_int_1d(i3)            !< warn:    shape /= [1]
+    !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+    call pass_int_1d(i3(n:n+3))     !< warn:    shape /= [1]
+    call pass_int(ia(1))            !< ok:      allocatable
+    call pass_int(ia(n))            !< ok:      allocatable
+    call pass_int_1d(ia)            !< ok:      allocatable
+    call pass_int_1d(ia(n:n+3))     !< ok:      allocatable
+
+    !WARNING: Passing global variable 'x1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+    call pass_real(x1)              !< warn:    x1 from common
+    !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+    call pass_real_1d(y1)           !< warn:    y1 from common or offset /= 0
+    !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+    call pass_real(y1(1))           !< warn:    offset /= 0
+    !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+    call pass_real(y1(n))           !< warn:    offset /= 0
+    !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+    call pass_real_1d(y1(n:n+3))    !< warn:    offset /= 0
+
+    !WARNING: Passing global variable 'y2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+    call pass_real(y2)              !< warn:    offset /= 0
+    !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+    call pass_real_1d(x2)           !< warn:    more than one variable in common block
+    !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+    call pass_real(x2(1))           !< warn:    more than one variable in common block
+    !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+    call pass_real(x2(n))           !< warn:    more than one variable in common block
+    !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+    call pass_real_1d(x2(n:n+3))    !< warn:    more than one variable in common block
+
+    !WARNING: Passing global variable 'z' from COMMON 'fm' as function argument [-Wpass-global-variable]
+    call pass_real_1d(z)            !< warn:    z from common
+    call pass_real(z(1))            !< ok:      single element/begin of mem block
+    call pass_real(z(n))            !< ok:      single element/begin of mem block
+    call pass_real_1d(z(n:n+3))     !< ok:      mem block
+
+    !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+    call pass_real_1d(z2)           !< warn:    shape /= [1]
+    !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+    call pass_real(z2(1))           !< warn:    shape /= [1]
+    !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+    call pass_real(z2(n))           !< warn:    shape /= [1]
+    !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+    call pass_real_1d(z2(n:n+3))    !< warn:    shape /= [1]
+  end subroutine explicit_test
+end module explicit_test_mod
+
+subroutine module_test(n)
+  use explicit_test_mod, only: i1, i2, i3, ia
+  implicit none (type, external)
+  integer, intent(in) :: n
+
+  external :: imp_pass_int, imp_pass_int_1d
+
+  !WARNING: Passing global variable 'i1' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+  call imp_pass_int(i1)              !< warn:    i1 from common
+  call imp_pass_int(i2(1))           !< ok:      single element/begin of mem block
+  call imp_pass_int(i2(n))           !< ok:      single element/begin of mem block
+  !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+  call imp_pass_int(i3(1))           !< warn:    shape /= [1]
+  !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+  call imp_pass_int(i3(n))           !< warn:    shape /= [1]
+  call imp_pass_int(ia(1))           !< ok:      allocatable
+  call imp_pass_int(ia(n))           !< ok:      allocatable
+
+  !WARNING: Passing global variable 'i2' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+  call imp_pass_int_1d(i2)           !< warn:    i2 from module
+  call imp_pass_int_1d(i2(n:n+3))    !< ok:      mem block
+  !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+  call imp_pass_int_1d(i3)           !< warn:    i3 from module & shape /= [1]
+  !WARNING: Passing global variable 'i3' from MODULE 'explicit_test_mod' as function argument [-Wpass-global-variable]
+  call imp_pass_int_1d(i3(n:n+3))    !< warn:    shape /= [1]
+  call imp_pass_int_1d(ia)           !< ok:      allocatable
+  call imp_pass_int_1d(ia(n:n+3))    !< ok:      allocatable
+end subroutine module_test
+
+subroutine implicit_test(n)
+  implicit none (type, external)
+  integer, intent(in) :: n
+  real :: x1, y1
+  real :: x2, y2
+  real :: z, z2
+  common /xy1/ x1, y1(1)
+  common /xy2/ x2(1), y2
+  common /fm/ z(1)
+  common /fm_bad/ z2(5)
+
+  external :: imp_pass_real, imp_pass_real_1d
+
+  !WARNING: Passing global variable 'x1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+  call imp_pass_real(x1)             !< warn:    x1 from common
+  !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(y1)          !< warn:    y1 from common and offset /= 0
+  !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+  call imp_pass_real(y1(1))          !< warn:    offset /= 0
+  !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+  call imp_pass_real(y1(n))          !< warn:    offset /= 0
+  !WARNING: Passing global variable 'y1' from COMMON 'xy1' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(y1(n:n+3))   !< warn:    offset /= 0
+
+  !WARNING: Passing global variable 'y2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+  call imp_pass_real(y2)             !< warn:    y2 from common and offset /= 0
+  !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(x2)          !< warn:    x2 from common
+  !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+  call imp_pass_real(x2(1))          !< warn:    more than one variable in common
+  !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+  call imp_pass_real(x2(n))          !< warn:    more than one variable in common
+  !WARNING: Passing global variable 'x2' from COMMON 'xy2' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(x2(n:n+3))   !< warn:    more than one variable in common
+
+  !WARNING: Passing global variable 'z' from COMMON 'fm' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(z)           !< warn:    z from common
+  call imp_pass_real(z(1))           !< ok:      single element/begin of mem block
+  call imp_pass_real(z(n))           !< ok:      single element/begin of mem block
+  call imp_pass_real_1d(z(n:n+3))    !< ok:      mem block
+
+  !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(z2)          !< warn:    z2 from common, shape /= [1]
+  !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+  call imp_pass_real(z2(1))          !< warn:    shape /= [1]
+  !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+  call imp_pass_real(z2(n))          !< warn:    shape /= [1]
+  !WARNING: Passing global variable 'z2' from COMMON 'fm_bad' as function argument [-Wpass-global-variable]
+  call imp_pass_real_1d(z2(n:n+3))   !< warn:    shape /= [1]
+end subroutine implicit_test

>From 6d0784cb564260fe82aea230c7347156d9a1730b Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 10:42:24 +0200
Subject: [PATCH 03/15] Initial implementation of CheckPassGlobalVariable

---
 flang/lib/Semantics/check-call.cpp | 83 +++++++++++++++++++++++++++++-
 1 file changed, 81 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 81c53aaf9e339..c8208a384a622 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -26,8 +26,81 @@ namespace characteristics = Fortran::evaluate::characteristics;
 
 namespace Fortran::semantics {
 
+// Raise warnings for some dangerous context of passing global variables
+// - any variable from common blocks except
+//   - 1-element arrays being single member of COMMON
+// - avy variable from module except
+//   - having attribute PARAMETER
+//   - being arrays having 1-D rank and is not having ALLOCATABLE or POINTER or
+//       VOLATILE attributes
+static void CheckPassGlobalVariable(
+    const evaluate::Expr<evaluate::SomeType> &actual,
+    const parser::ContextualMessages &messages, SemanticsContext &context,
+    evaluate::FoldingContext &foldingContext) {
+  const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
+  if (actualFirstSymbol) {
+    bool warn{false};
+    std::string ownerType{""};
+    std::string ownerName{""};
+    if (actualFirstSymbol->flags().test(Symbol::Flag::InCommonBlock)) {
+      const Symbol *common{FindCommonBlockContaining(*actualFirstSymbol)};
+      ownerType = "COMMON";
+      ownerName = common->name().ToString();
+      if (!(actualFirstSymbol->Rank() == 1 &&
+                     actualFirstSymbol->offset() == 0)) {
+        warn |= true;
+      } else if (actualFirstSymbol->Rank() == 1) {
+        bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
+        if (!actualIsArrayElement) {
+          warn |= true;
+        }
+        if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
+            dims && dims->IsExplicitShape()) {
+          if (!((*dims)[0].lbound().GetExplicit() ==
+                  (*dims)[0].ubound().GetExplicit())) {
+            warn |= true;
+          }
+        }
+        if (common->get<CommonBlockDetails>().objects().size() > 1) {
+          warn |= true;
+        }
+      }
+    } else if (const auto &owner{actualFirstSymbol->GetUltimate().owner()};
+        owner.IsModule() || owner.IsSubmodule()) {
+      const Scope *module{FindModuleContaining(owner)};
+      ownerType = "MODULE";
+      ownerName = module->GetName()->ToString();
+      if (actualFirstSymbol->attrs().test(Attr::PARAMETER)) {
+        warn |= false;
+      } else if (actualFirstSymbol->Rank() != 1) {
+        warn |= true;
+      } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
+          !actualFirstSymbol->attrs().test(Attr::POINTER) &&
+          !actualFirstSymbol->attrs().test(Attr::VOLATILE)) {
+        bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
+        if (!actualIsArrayElement) {
+          warn |= true;
+        }
+        if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
+            dims && dims->IsExplicitShape()) {
+          if (!((*dims)[0].lbound().GetExplicit() ==
+                  (*dims)[0].ubound().GetExplicit())) {
+            warn |= true;
+          }
+        }
+      }
+    }
+    if (warn) {
+      context.Warn(common::UsageWarning::PassGlobalVariable, messages.at(),
+          "Passing global variable '%s' from %s '%s' as function argument"_warn_en_US,
+          actualFirstSymbol->name(), ownerType, ownerName);
+    }
+  }
+}
+
 static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
-    parser::ContextualMessages &messages, SemanticsContext &context) {
+    parser::ContextualMessages &messages, SemanticsContext &context,
+    evaluate::FoldingContext &foldingContext) {
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   if (auto kw{arg.keyword()}) {
@@ -118,6 +191,10 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
       }
     }
   }
+
+  if (const auto *expr{arg.UnwrapExpr()}) {
+    CheckPassGlobalVariable(*expr, messages, context, foldingContext);
+  }
 }
 
 // F'2023 15.5.2.12p1: "Sequence association only applies when the dummy
@@ -1153,6 +1230,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     messages.Say(
         "%VAL argument must be a scalar numeric or logical expression"_err_en_US);
   }
+
+  CheckPassGlobalVariable(actual, messages, context, foldingContext);
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,
@@ -2409,7 +2488,7 @@ bool CheckArguments(const characteristics::Procedure &proc,
       auto restorer{messages.SetMessages(implicitBuffer)};
       for (auto &actual : actuals) {
         if (actual) {
-          CheckImplicitInterfaceArg(*actual, messages, context);
+          CheckImplicitInterfaceArg(*actual, messages, context, foldingContext);
         }
       }
     }

>From 0b79c37fb1a6c6e74021e3cb05b096c97362503c Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 11:12:43 +0200
Subject: [PATCH 04/15] Comment checks of single-element arrays

---
 flang/lib/Semantics/check-call.cpp | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c8208a384a622..e358934e9a5e0 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -56,6 +56,7 @@ static void CheckPassGlobalVariable(
         }
         if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
             dims && dims->IsExplicitShape()) {
+          // tricky way to check that array has only one element
           if (!((*dims)[0].lbound().GetExplicit() ==
                   (*dims)[0].ubound().GetExplicit())) {
             warn |= true;
@@ -83,6 +84,7 @@ static void CheckPassGlobalVariable(
         }
         if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
             dims && dims->IsExplicitShape()) {
+          // tricky way to check that array has only one element
           if (!((*dims)[0].lbound().GetExplicit() ==
                   (*dims)[0].ubound().GetExplicit())) {
             warn |= true;

>From 82582e6b0a9bbfc10615616f5796625811566660 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 10:43:27 +0200
Subject: [PATCH 05/15] GetShape for variables loaded from modules

---
 flang/lib/Semantics/symbol.cpp | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 6152f61fafd7f..3432b1e235618 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -453,6 +453,8 @@ bool Symbol::IsFuncResult() const {
 const ArraySpec *Symbol::GetShape() const {
   if (const auto *details{std::get_if<ObjectEntityDetails>(&details_)}) {
     return &details->shape();
+  } else if (const auto *details{std::get_if<UseDetails>(&details_)}) {
+    return details->symbol().GetShape();
   } else {
     return nullptr;
   }

>From ec0dfc8b1d3442f88b367de1168e9b46a1468e27 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 10:46:05 +0200
Subject: [PATCH 06/15] Allow passing private

---
 flang/lib/Semantics/check-call.cpp | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index e358934e9a5e0..75ea243d2212d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -30,7 +30,7 @@ namespace Fortran::semantics {
 // - any variable from common blocks except
 //   - 1-element arrays being single member of COMMON
 // - avy variable from module except
-//   - having attribute PARAMETER
+//   - having attribute PARAMETER or PRIVATE
 //   - being arrays having 1-D rank and is not having ALLOCATABLE or POINTER or
 //       VOLATILE attributes
 static void CheckPassGlobalVariable(
@@ -71,7 +71,8 @@ static void CheckPassGlobalVariable(
       const Scope *module{FindModuleContaining(owner)};
       ownerType = "MODULE";
       ownerName = module->GetName()->ToString();
-      if (actualFirstSymbol->attrs().test(Attr::PARAMETER)) {
+      if (actualFirstSymbol->attrs().test(Attr::PARAMETER) ||
+          actualFirstSymbol->attrs().test(Attr::PRIVATE)) {
         warn |= false;
       } else if (actualFirstSymbol->Rank() != 1) {
         warn |= true;

>From 256a11e842f8d83c6d17c90e48608d671003fc6c Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 10:52:29 +0200
Subject: [PATCH 07/15] Allow passing derived types

---
 flang/lib/Semantics/check-call.cpp | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 75ea243d2212d..d69228ef38af1 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -31,6 +31,7 @@ namespace Fortran::semantics {
 //   - 1-element arrays being single member of COMMON
 // - avy variable from module except
 //   - having attribute PARAMETER or PRIVATE
+//   - having DERIVED type
 //   - being arrays having 1-D rank and is not having ALLOCATABLE or POINTER or
 //       VOLATILE attributes
 static void CheckPassGlobalVariable(
@@ -74,6 +75,10 @@ static void CheckPassGlobalVariable(
       if (actualFirstSymbol->attrs().test(Attr::PARAMETER) ||
           actualFirstSymbol->attrs().test(Attr::PRIVATE)) {
         warn |= false;
+      } else if (auto type{characteristics::TypeAndShape::Characterize(
+                     actualFirstSymbol, foldingContext)};
+          type->type().category() == TypeCategory::Derived) {
+        warn |= false;
       } else if (actualFirstSymbol->Rank() != 1) {
         warn |= true;
       } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&

>From 1f304652ea3db88c6a646b3e0551081c333d14aa Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 10:56:27 +0200
Subject: [PATCH 08/15] Allow passing to intrinsic

---
 flang/lib/Semantics/check-call.cpp | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index d69228ef38af1..8c4b73a477730 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -29,15 +29,18 @@ namespace Fortran::semantics {
 // Raise warnings for some dangerous context of passing global variables
 // - any variable from common blocks except
 //   - 1-element arrays being single member of COMMON
+//   - passed to intrinsic
 // - avy variable from module except
 //   - having attribute PARAMETER or PRIVATE
 //   - having DERIVED type
+//   - passed to intrinsic
 //   - being arrays having 1-D rank and is not having ALLOCATABLE or POINTER or
 //       VOLATILE attributes
 static void CheckPassGlobalVariable(
     const evaluate::Expr<evaluate::SomeType> &actual,
     const parser::ContextualMessages &messages, SemanticsContext &context,
-    evaluate::FoldingContext &foldingContext) {
+    evaluate::FoldingContext &foldingContext,
+    const evaluate::SpecificIntrinsic *intrinsic) {
   const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
   if (actualFirstSymbol) {
     bool warn{false};
@@ -47,7 +50,9 @@ static void CheckPassGlobalVariable(
       const Symbol *common{FindCommonBlockContaining(*actualFirstSymbol)};
       ownerType = "COMMON";
       ownerName = common->name().ToString();
-      if (!(actualFirstSymbol->Rank() == 1 &&
+      if (intrinsic) {
+        warn |= false;
+      } else if (!(actualFirstSymbol->Rank() == 1 &&
                      actualFirstSymbol->offset() == 0)) {
         warn |= true;
       } else if (actualFirstSymbol->Rank() == 1) {
@@ -79,6 +84,8 @@ static void CheckPassGlobalVariable(
                      actualFirstSymbol, foldingContext)};
           type->type().category() == TypeCategory::Derived) {
         warn |= false;
+      } else if (intrinsic) {
+        warn |= false;
       } else if (actualFirstSymbol->Rank() != 1) {
         warn |= true;
       } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
@@ -201,7 +208,8 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
   }
 
   if (const auto *expr{arg.UnwrapExpr()}) {
-    CheckPassGlobalVariable(*expr, messages, context, foldingContext);
+    CheckPassGlobalVariable(*expr, messages, context, foldingContext,
+        /*intrinsic=*/nullptr);
   }
 }
 
@@ -1239,7 +1247,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         "%VAL argument must be a scalar numeric or logical expression"_err_en_US);
   }
 
-  CheckPassGlobalVariable(actual, messages, context, foldingContext);
+  CheckPassGlobalVariable(actual, messages, context, foldingContext, intrinsic);
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,

>From d0547e40240de56ae21868b411f1edddb7aa67cb Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 11:05:24 +0200
Subject: [PATCH 09/15] Allow passing to pure

---
 flang/lib/Semantics/check-call.cpp | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 8c4b73a477730..b2cf088ced0cc 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -30,17 +30,20 @@ namespace Fortran::semantics {
 // - any variable from common blocks except
 //   - 1-element arrays being single member of COMMON
 //   - passed to intrinsic
+//   - passed to PURE procedure
 // - avy variable from module except
 //   - having attribute PARAMETER or PRIVATE
 //   - having DERIVED type
 //   - passed to intrinsic
+//   - passed to PURE procedure
 //   - being arrays having 1-D rank and is not having ALLOCATABLE or POINTER or
 //       VOLATILE attributes
 static void CheckPassGlobalVariable(
     const evaluate::Expr<evaluate::SomeType> &actual,
     const parser::ContextualMessages &messages, SemanticsContext &context,
     evaluate::FoldingContext &foldingContext,
-    const evaluate::SpecificIntrinsic *intrinsic) {
+    const evaluate::SpecificIntrinsic *intrinsic,
+    const characteristics::Procedure *procedure) {
   const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
   if (actualFirstSymbol) {
     bool warn{false};
@@ -52,6 +55,8 @@ static void CheckPassGlobalVariable(
       ownerName = common->name().ToString();
       if (intrinsic) {
         warn |= false;
+      } else if (procedure && procedure->IsPure()) {
+        warn |= false;
       } else if (!(actualFirstSymbol->Rank() == 1 &&
                      actualFirstSymbol->offset() == 0)) {
         warn |= true;
@@ -86,6 +91,8 @@ static void CheckPassGlobalVariable(
         warn |= false;
       } else if (intrinsic) {
         warn |= false;
+      } else if (procedure && procedure->IsPure()) {
+        warn |= false;
       } else if (actualFirstSymbol->Rank() != 1) {
         warn |= true;
       } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
@@ -209,7 +216,7 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
 
   if (const auto *expr{arg.UnwrapExpr()}) {
     CheckPassGlobalVariable(*expr, messages, context, foldingContext,
-        /*intrinsic=*/nullptr);
+        /*intrinsic=*/nullptr, /*procedure=*/nullptr);
   }
 }
 
@@ -1247,7 +1254,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         "%VAL argument must be a scalar numeric or logical expression"_err_en_US);
   }
 
-  CheckPassGlobalVariable(actual, messages, context, foldingContext, intrinsic);
+  CheckPassGlobalVariable(
+      actual, messages, context, foldingContext, intrinsic, &procedure);
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,

>From b0dc77f9098631472aecb31e713a0197b5635dfd Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 11:11:26 +0200
Subject: [PATCH 10/15] Allow passing to VALUE dummy argument

---
 flang/lib/Semantics/check-call.cpp | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index b2cf088ced0cc..5e4ac41c13ef1 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -31,11 +31,13 @@ namespace Fortran::semantics {
 //   - 1-element arrays being single member of COMMON
 //   - passed to intrinsic
 //   - passed to PURE procedure
+//   - passed to VALUE dummy argument
 // - avy variable from module except
 //   - having attribute PARAMETER or PRIVATE
 //   - having DERIVED type
 //   - passed to intrinsic
 //   - passed to PURE procedure
+//   - passed to VALUE dummy argument
 //   - being arrays having 1-D rank and is not having ALLOCATABLE or POINTER or
 //       VOLATILE attributes
 static void CheckPassGlobalVariable(
@@ -43,7 +45,7 @@ static void CheckPassGlobalVariable(
     const parser::ContextualMessages &messages, SemanticsContext &context,
     evaluate::FoldingContext &foldingContext,
     const evaluate::SpecificIntrinsic *intrinsic,
-    const characteristics::Procedure *procedure) {
+    const characteristics::Procedure *procedure, bool dummyIsValue = false) {
   const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
   if (actualFirstSymbol) {
     bool warn{false};
@@ -57,6 +59,8 @@ static void CheckPassGlobalVariable(
         warn |= false;
       } else if (procedure && procedure->IsPure()) {
         warn |= false;
+      } else if (dummyIsValue) {
+        warn |= false;
       } else if (!(actualFirstSymbol->Rank() == 1 &&
                      actualFirstSymbol->offset() == 0)) {
         warn |= true;
@@ -93,6 +97,8 @@ static void CheckPassGlobalVariable(
         warn |= false;
       } else if (procedure && procedure->IsPure()) {
         warn |= false;
+      } else if (dummyIsValue) {
+        warn |= false;
       } else if (actualFirstSymbol->Rank() != 1) {
         warn |= true;
       } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
@@ -1254,8 +1260,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         "%VAL argument must be a scalar numeric or logical expression"_err_en_US);
   }
 
-  CheckPassGlobalVariable(
-      actual, messages, context, foldingContext, intrinsic, &procedure);
+  CheckPassGlobalVariable(actual, messages, context, foldingContext, intrinsic,
+      &procedure, dummyIsValue);
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,

>From f9280db8314330bce6246d60faa22da2e44fae07 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 21:00:55 +0200
Subject: [PATCH 11/15] Add second set of tests

---
 .../Semantics/pass-global-variables02.f90     | 61 +++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 flang/test/Semantics/pass-global-variables02.f90

diff --git a/flang/test/Semantics/pass-global-variables02.f90 b/flang/test/Semantics/pass-global-variables02.f90
new file mode 100644
index 0000000000000..46733665bfef8
--- /dev/null
+++ b/flang/test/Semantics/pass-global-variables02.f90
@@ -0,0 +1,61 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1 -Werror -Wpass-global-variable
+module test_mod
+  implicit none (type, external)
+
+  type :: wt
+    integer :: ival
+  end type wt
+  type :: qt
+    type(wt) :: w
+  end type qt
+  type(wt) :: w(2)
+  type(qt) :: q
+
+  integer, parameter :: ipar = 1
+  integer, private :: ipri
+  integer, public ::  ipub
+
+  common /ex/ ic
+  integer :: ic
+
+contains
+  subroutine pass_int_in(i)
+    integer, intent(in) :: i
+  end subroutine pass_int_in
+  subroutine pass_int(i)
+    integer, intent(inout) :: i
+  end subroutine pass_int
+  pure subroutine pure_int(i)
+    integer, intent(inout) :: i
+  end subroutine pure_int
+  subroutine pass_ival(i)
+    integer, value :: i
+  end subroutine pass_ival
+  subroutine pass_qt(q)
+    type(qt), intent(in) :: q
+  end subroutine pass_qt
+
+  subroutine tests()
+
+    call pass_ival(ipub)       !< ok:      pass to value
+    call pass_int_in(ipar)     !< ok:      pass parameter
+    call pass_int(ipri)        !< ok:      pass private
+    !WARNING: Passing global variable 'ipub' from MODULE 'test_mod' as function argument [-Wpass-global-variable]
+    call pass_int(ipub)        !< warn:    pass public
+    call pure_int(ipub)        !< ok:      pass to pure
+    call pass_int(w(1)%ival)   !< ok:      comes from derived
+    call pass_qt(q)            !< ok:      derived
+
+    ipub = iand(ipub, ipar)    !< ok:      passed to intrinsic
+
+    call pass_ival(ic)         !< ok:      passed to value
+    !WARNING: Passing global variable 'ic' from COMMON 'ex' as function argument [-Wpass-global-variable]
+    call pass_int_in(ic)       !< warn:    intent(in) does not guarantee that ic is not changing during call
+    !WARNING: Passing global variable 'ic' from COMMON 'ex' as function argument [-Wpass-global-variable]
+    call pass_int(ic)          !< warn:    global variable may be changed during call
+    call pure_int(ic)          !< ok:      pure keeps value
+
+    ic = iand(ic, ic)          !< ok:      passed to intrinsic
+
+  end subroutine tests
+end module test_mod

>From 933b5067083c4ecf7da7c6fc19a080d2b75ce01d Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 21:26:38 +0200
Subject: [PATCH 12/15] Disable default PassGlobalVariable

---
 flang/lib/Support/Fortran-features.cpp | 1 -
 1 file changed, 1 deletion(-)

diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index bb5c7b56634e8..4a6fb8d75a135 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -149,7 +149,6 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnUsage_.set(UsageWarning::HostAssociatedIntentOutInSpecExpr);
   warnUsage_.set(UsageWarning::NonVolatilePointerToVolatile);
   warnUsage_.set(UsageWarning::RealConstantWidening);
-  warnUsage_.set(UsageWarning::PassGlobalVariable);
   // New warnings, on by default
   warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
   warnLanguage_.set(LanguageFeature::NullActualForAllocatable);

>From 39a63c800cb77d3d48a7a7dda816fefd3113c53d Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Tue, 7 Oct 2025 21:29:07 +0200
Subject: [PATCH 13/15] Do not raise PassGlobalVariable warning in some tests

---
 flang/test/Semantics/call05.f90      | 2 +-
 flang/test/Semantics/call07.f90      | 2 +-
 flang/test/Semantics/stmt-func02.f90 | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/flang/test/Semantics/call05.f90 b/flang/test/Semantics/call05.f90
index b9b463a44979d..c41b736329c3b 100644
--- a/flang/test/Semantics/call05.f90
+++ b/flang/test/Semantics/call05.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Wno-pass-global-variable
 ! Test 15.5.2.5 constraints and restrictions for POINTER & ALLOCATABLE
 ! arguments when both sides of the call have the same attributes.
 
diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
index 7e29fb74dd615..8352bee6f8a5e 100644
--- a/flang/test/Semantics/call07.f90
+++ b/flang/test/Semantics/call07.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Wno-pass-global-variable
 ! Test 15.5.2.7 constraints and restrictions for POINTER dummy arguments.
 
 module m
diff --git a/flang/test/Semantics/stmt-func02.f90 b/flang/test/Semantics/stmt-func02.f90
index 10166a0abf7b1..04f643356f55a 100644
--- a/flang/test/Semantics/stmt-func02.f90
+++ b/flang/test/Semantics/stmt-func02.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Wno-pass-global-variable
 module m1
  contains
   real function rf2(x)

>From c7fc7bd15d9bd5ff6058cc4dafc7ee6bfa209831 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Wed, 8 Oct 2025 08:20:57 +0200
Subject: [PATCH 14/15] Fast exit if actualFirstSymbol is not constructed

---
 flang/lib/Semantics/check-call.cpp | 135 +++++++++++++++--------------
 1 file changed, 68 insertions(+), 67 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 5e4ac41c13ef1..06957782c94dd 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -47,82 +47,83 @@ static void CheckPassGlobalVariable(
     const evaluate::SpecificIntrinsic *intrinsic,
     const characteristics::Procedure *procedure, bool dummyIsValue = false) {
   const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
-  if (actualFirstSymbol) {
-    bool warn{false};
-    std::string ownerType{""};
-    std::string ownerName{""};
-    if (actualFirstSymbol->flags().test(Symbol::Flag::InCommonBlock)) {
-      const Symbol *common{FindCommonBlockContaining(*actualFirstSymbol)};
-      ownerType = "COMMON";
-      ownerName = common->name().ToString();
-      if (intrinsic) {
-        warn |= false;
-      } else if (procedure && procedure->IsPure()) {
-        warn |= false;
-      } else if (dummyIsValue) {
-        warn |= false;
-      } else if (!(actualFirstSymbol->Rank() == 1 &&
-                     actualFirstSymbol->offset() == 0)) {
+  if (!actualFirstSymbol) {
+    return;
+  }
+  bool warn{false};
+  std::string ownerType{""};
+  std::string ownerName{""};
+  if (actualFirstSymbol->flags().test(Symbol::Flag::InCommonBlock)) {
+    const Symbol *common{FindCommonBlockContaining(*actualFirstSymbol)};
+    ownerType = "COMMON";
+    ownerName = common->name().ToString();
+    if (intrinsic) {
+      warn |= false;
+    } else if (procedure && procedure->IsPure()) {
+      warn |= false;
+    } else if (dummyIsValue) {
+      warn |= false;
+    } else if (!(actualFirstSymbol->Rank() == 1 &&
+                   actualFirstSymbol->offset() == 0)) {
+      warn |= true;
+    } else if (actualFirstSymbol->Rank() == 1) {
+      bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
+      if (!actualIsArrayElement) {
         warn |= true;
-      } else if (actualFirstSymbol->Rank() == 1) {
-        bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
-        if (!actualIsArrayElement) {
-          warn |= true;
-        }
-        if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
-            dims && dims->IsExplicitShape()) {
-          // tricky way to check that array has only one element
-          if (!((*dims)[0].lbound().GetExplicit() ==
-                  (*dims)[0].ubound().GetExplicit())) {
-            warn |= true;
-          }
-        }
-        if (common->get<CommonBlockDetails>().objects().size() > 1) {
+      }
+      if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
+          dims && dims->IsExplicitShape()) {
+        // tricky way to check that array has only one element
+        if (!((*dims)[0].lbound().GetExplicit() ==
+                (*dims)[0].ubound().GetExplicit())) {
           warn |= true;
         }
       }
-    } else if (const auto &owner{actualFirstSymbol->GetUltimate().owner()};
-        owner.IsModule() || owner.IsSubmodule()) {
-      const Scope *module{FindModuleContaining(owner)};
-      ownerType = "MODULE";
-      ownerName = module->GetName()->ToString();
-      if (actualFirstSymbol->attrs().test(Attr::PARAMETER) ||
-          actualFirstSymbol->attrs().test(Attr::PRIVATE)) {
-        warn |= false;
-      } else if (auto type{characteristics::TypeAndShape::Characterize(
-                     actualFirstSymbol, foldingContext)};
-          type->type().category() == TypeCategory::Derived) {
-        warn |= false;
-      } else if (intrinsic) {
-        warn |= false;
-      } else if (procedure && procedure->IsPure()) {
-        warn |= false;
-      } else if (dummyIsValue) {
-        warn |= false;
-      } else if (actualFirstSymbol->Rank() != 1) {
+      if (common->get<CommonBlockDetails>().objects().size() > 1) {
         warn |= true;
-      } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
-          !actualFirstSymbol->attrs().test(Attr::POINTER) &&
-          !actualFirstSymbol->attrs().test(Attr::VOLATILE)) {
-        bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
-        if (!actualIsArrayElement) {
+      }
+    }
+  } else if (const auto &owner{actualFirstSymbol->GetUltimate().owner()};
+      owner.IsModule() || owner.IsSubmodule()) {
+    const Scope *module{FindModuleContaining(owner)};
+    ownerType = "MODULE";
+    ownerName = module->GetName()->ToString();
+    if (actualFirstSymbol->attrs().test(Attr::PARAMETER) ||
+        actualFirstSymbol->attrs().test(Attr::PRIVATE)) {
+      warn |= false;
+    } else if (auto type{characteristics::TypeAndShape::Characterize(
+                   actualFirstSymbol, foldingContext)};
+        type->type().category() == TypeCategory::Derived) {
+      warn |= false;
+    } else if (intrinsic) {
+      warn |= false;
+    } else if (procedure && procedure->IsPure()) {
+      warn |= false;
+    } else if (dummyIsValue) {
+      warn |= false;
+    } else if (actualFirstSymbol->Rank() != 1) {
+      warn |= true;
+    } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
+        !actualFirstSymbol->attrs().test(Attr::POINTER) &&
+        !actualFirstSymbol->attrs().test(Attr::VOLATILE)) {
+      bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
+      if (!actualIsArrayElement) {
+        warn |= true;
+      }
+      if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
+          dims && dims->IsExplicitShape()) {
+        // tricky way to check that array has only one element
+        if (!((*dims)[0].lbound().GetExplicit() ==
+                (*dims)[0].ubound().GetExplicit())) {
           warn |= true;
         }
-        if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
-            dims && dims->IsExplicitShape()) {
-          // tricky way to check that array has only one element
-          if (!((*dims)[0].lbound().GetExplicit() ==
-                  (*dims)[0].ubound().GetExplicit())) {
-            warn |= true;
-          }
-        }
       }
     }
-    if (warn) {
-      context.Warn(common::UsageWarning::PassGlobalVariable, messages.at(),
-          "Passing global variable '%s' from %s '%s' as function argument"_warn_en_US,
-          actualFirstSymbol->name(), ownerType, ownerName);
-    }
+  }
+  if (warn) {
+    context.Warn(common::UsageWarning::PassGlobalVariable, messages.at(),
+        "Passing global variable '%s' from %s '%s' as function argument"_warn_en_US,
+        actualFirstSymbol->name(), ownerType, ownerName);
   }
 }
 

>From 38bc57ccb3a252899b2f7907fc0962dbb82d6166 Mon Sep 17 00:00:00 2001
From: "Igor S. Gerasimov" <foxtranigor at gmail.com>
Date: Wed, 8 Oct 2025 09:21:37 +0200
Subject: [PATCH 15/15] Avoid |= for warn; give the reason instead

---
 flang/lib/Semantics/check-call.cpp | 31 +++++++++++++++---------------
 1 file changed, 16 insertions(+), 15 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 06957782c94dd..28b4c8f6cef30 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -58,29 +58,29 @@ static void CheckPassGlobalVariable(
     ownerType = "COMMON";
     ownerName = common->name().ToString();
     if (intrinsic) {
-      warn |= false;
+      // intrinsics can not change any global variable
     } else if (procedure && procedure->IsPure()) {
-      warn |= false;
+      // pure procedures can not affect global state
     } else if (dummyIsValue) {
-      warn |= false;
+      // copy of variable is passing
     } else if (!(actualFirstSymbol->Rank() == 1 &&
                    actualFirstSymbol->offset() == 0)) {
-      warn |= true;
+      warn = true;
     } else if (actualFirstSymbol->Rank() == 1) {
       bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
       if (!actualIsArrayElement) {
-        warn |= true;
+        warn = true;
       }
       if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
           dims && dims->IsExplicitShape()) {
         // tricky way to check that array has only one element
         if (!((*dims)[0].lbound().GetExplicit() ==
                 (*dims)[0].ubound().GetExplicit())) {
-          warn |= true;
+          warn = true;
         }
       }
       if (common->get<CommonBlockDetails>().objects().size() > 1) {
-        warn |= true;
+        warn = true;
       }
     }
   } else if (const auto &owner{actualFirstSymbol->GetUltimate().owner()};
@@ -90,32 +90,33 @@ static void CheckPassGlobalVariable(
     ownerName = module->GetName()->ToString();
     if (actualFirstSymbol->attrs().test(Attr::PARAMETER) ||
         actualFirstSymbol->attrs().test(Attr::PRIVATE)) {
-      warn |= false;
+      // parameter can not be changed anywhere
+      // private may be used for singletons
     } else if (auto type{characteristics::TypeAndShape::Characterize(
                    actualFirstSymbol, foldingContext)};
         type->type().category() == TypeCategory::Derived) {
-      warn |= false;
+      // derived types are easy to maintain
     } else if (intrinsic) {
-      warn |= false;
+      // intrinsics can not change any global variable
     } else if (procedure && procedure->IsPure()) {
-      warn |= false;
+      // pure procedures can not affect global state
     } else if (dummyIsValue) {
-      warn |= false;
+      // copy of variable is passing
     } else if (actualFirstSymbol->Rank() != 1) {
-      warn |= true;
+      warn = true;
     } else if (!actualFirstSymbol->attrs().test(Attr::ALLOCATABLE) &&
         !actualFirstSymbol->attrs().test(Attr::POINTER) &&
         !actualFirstSymbol->attrs().test(Attr::VOLATILE)) {
       bool actualIsArrayElement{IsArrayElement(actual) != nullptr};
       if (!actualIsArrayElement) {
-        warn |= true;
+        warn = true;
       }
       if (const ArraySpec *dims{actualFirstSymbol->GetShape()};
           dims && dims->IsExplicitShape()) {
         // tricky way to check that array has only one element
         if (!((*dims)[0].lbound().GetExplicit() ==
                 (*dims)[0].ubound().GetExplicit())) {
-          warn |= true;
+          warn = true;
         }
       }
     }



More information about the flang-commits mailing list