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

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

@@ -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_;

flang/lib/Semantics/check-purity.h

@@ -23,6 +23,8 @@ public:
   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 &);
 

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

flang/test/Semantics/misc-intrinsics.f90

@@ -105,16 +105,19 @@ program test_size
       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

flang/test/Semantics/symbol03.f90

@@ -13,13 +13,6 @@ contains
   !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