[flang-commits] [flang] [flang] Catch doubly-nested internal subprograms (PR #175992)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/175992

The check for double-nested internal subprograms is missing cases nested in main programs.

Fixes https://github.com/llvm/llvm-project/issues/150820.

>From a7f7f8831c67e53aa57153b4e775dc68624d5e15 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 14 Jan 2026 09:10:04 -0800
Subject: [PATCH] [flang] Catch doubly-nested internal subprograms

The check for double-nested internal subprograms is missing
cases nested in main programs.

Fixes https://github.com/llvm/llvm-project/issues/150820.
---
 flang/lib/Semantics/check-purity.cpp     |  6 +++++-
 flang/lib/Semantics/check-purity.h       |  2 ++
 flang/test/Semantics/bug150820.f90       | 20 ++++++++++++++++++
 flang/test/Semantics/misc-intrinsics.f90 | 27 +++++++++++++-----------
 flang/test/Semantics/symbol03.f90        |  7 ------
 5 files changed, 42 insertions(+), 20 deletions(-)
 create mode 100644 flang/test/Semantics/bug150820.f90

diff --git a/flang/lib/Semantics/check-purity.cpp b/flang/lib/Semantics/check-purity.cpp
index 1046f363e9485..b327282f390e5 100644
--- a/flang/lib/Semantics/check-purity.cpp
+++ b/flang/lib/Semantics/check-purity.cpp
@@ -17,6 +17,7 @@ void PurityChecker::Enter(const parser::ExecutableConstruct &exec) {
         "An image control statement may not appear in a pure subprogram"_err_en_US);
   }
 }
+
 void PurityChecker::Enter(const parser::SubroutineSubprogram &subr) {
   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(subr.t)};
   Entered(
@@ -31,7 +32,10 @@ void PurityChecker::Enter(const parser::FunctionSubprogram &func) {
       stmt.source, std::get<std::list<parser::PrefixSpec>>(stmt.statement.t));
 }
 
-void PurityChecker::Leave(const parser::FunctionSubprogram &func) { Left(); }
+void PurityChecker::Leave(const parser::FunctionSubprogram &) { Left(); }
+
+void PurityChecker::Enter(const parser::MainProgram &) { ++depth_; }
+void PurityChecker::Leave(const parser::MainProgram &) { --depth_; }
 
 bool PurityChecker::InPureSubprogram() const {
   return pureDepth_ >= 0 && depth_ >= pureDepth_;
diff --git a/flang/lib/Semantics/check-purity.h b/flang/lib/Semantics/check-purity.h
index a6551162325f9..4e01bdc00e0bc 100644
--- a/flang/lib/Semantics/check-purity.h
+++ b/flang/lib/Semantics/check-purity.h
@@ -23,6 +23,8 @@ class PurityChecker : public virtual BaseChecker {
   void Enter(const parser::ExecutableConstruct &);
   void Enter(const parser::SubroutineSubprogram &);
   void Leave(const parser::SubroutineSubprogram &);
+  void Enter(const parser::MainProgram &);
+  void Leave(const parser::MainProgram &);
   void Enter(const parser::FunctionSubprogram &);
   void Leave(const parser::FunctionSubprogram &);
 
diff --git a/flang/test/Semantics/bug150820.f90 b/flang/test/Semantics/bug150820.f90
new file mode 100644
index 0000000000000..5a369c47934ca
--- /dev/null
+++ b/flang/test/Semantics/bug150820.f90
@@ -0,0 +1,20 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1
+subroutine a
+ contains
+  subroutine b
+   contains
+    !ERROR: An internal subprogram may not contain an internal subprogram
+    subroutine c
+    end
+  end
+end
+
+program p
+ contains
+  subroutine b
+   contains
+    !ERROR: An internal subprogram may not contain an internal subprogram
+    subroutine c
+    end
+  end
+end
diff --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90
index a7895f7b7f16f..517a8b247ad28 100644
--- a/flang/test/Semantics/misc-intrinsics.f90
+++ b/flang/test/Semantics/misc-intrinsics.f90
@@ -105,16 +105,19 @@ subroutine test(arg, assumedRank, poly)
       print *, lbound(assumedRank, dim=2)
       print *, ubound(assumedRank, dim=2)
     end select
-   contains
-    subroutine inner
-      !ERROR: A dim= argument is required for 'size' when the array is assumed-size
-      print *, size(arg)
-      print *, size(arg, dim=1) ! ok
-      !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
-      print *, ubound(arg)
-      print *, ubound(arg, dim=1) ! ok
-      !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
-      print *, shape(arg)
-    end
-  end subroutine
+  end
+end
+subroutine test2(arg)
+  real, dimension(5, *) :: arg
+ contains
+  subroutine inner
+    !ERROR: A dim= argument is required for 'size' when the array is assumed-size
+    print *, size(arg)
+    print *, size(arg, dim=1) ! ok
+    !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
+    print *, ubound(arg)
+    print *, ubound(arg, dim=1) ! ok
+    !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
+    print *, shape(arg)
+  end
 end
diff --git a/flang/test/Semantics/symbol03.f90 b/flang/test/Semantics/symbol03.f90
index 62472495d9736..4651669020473 100644
--- a/flang/test/Semantics/symbol03.f90
+++ b/flang/test/Semantics/symbol03.f90
@@ -13,13 +13,6 @@ subroutine s
   !DEF: /MAIN/s/y (Implicit) ObjectEntity REAL(4)
   !DEF: /MAIN/s/x HostAssoc INTEGER(4)
   y = x
- contains
-  !DEF: /MAIN/s/s2 (Subroutine) Subprogram
-  subroutine s2
-   !DEF: /MAIN/s/s2/z (Implicit) ObjectEntity REAL(4)
-   !DEF: /MAIN/s/s2/x HostAssoc INTEGER(4)
-   z = x
-  end subroutine
  end subroutine
 end program