diff --git a/flang/lib/Semantics/check-purity.cpp b/flang/lib/Semantics/check-purity.cpp index 1046f363e948..b327282f390e 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>(subr.t)}; Entered( @@ -31,7 +32,10 @@ void PurityChecker::Enter(const parser::FunctionSubprogram &func) { stmt.source, std::get>(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 a6551162325f..4e01bdc00e0b 100644 --- a/flang/lib/Semantics/check-purity.h +++ b/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 &); diff --git a/flang/test/Semantics/bug150820.f90 b/flang/test/Semantics/bug150820.f90 new file mode 100644 index 000000000000..5a369c47934c --- /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 a7895f7b7f16..517a8b247ad2 100644 --- a/flang/test/Semantics/misc-intrinsics.f90 +++ b/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 diff --git a/flang/test/Semantics/symbol03.f90 b/flang/test/Semantics/symbol03.f90 index 62472495d973..465166902047 100644 --- a/flang/test/Semantics/symbol03.f90 +++ b/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