From b781a04f6aff145f43b6f87c5b987159c2b64123 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 10 Nov 2020 15:03:21 -0800 Subject: [PATCH] [flang] Allow labels on END statements. F18 clause 5.3.3 explicitly allows labels on program unit END statements. Label resolution code accounts for this for singleton program units, but incorrectly generates an error for host subprograms with internal subprograms. subroutine s(n) call s1(n) if (n == 0) goto 88 ! incorrect error print*, 's' contains subroutine s1(n) if (n == 0) goto 77 ! ok print*, 's1' 77 end subroutine s1 88 end Label resolution code makes a sequential pass over an entire file to collect label information for all subprograms, followed by a pass through that information for semantics checks. The problem is that END statements may be separated from prior subprogram code by internal subprogram definitions, so an END label can be associated with the wrong subprogram. There are several ways to fix this. Labels are always local to a subprogram. So the two separate passes over the entire file could probably instead be interleaved to perform analysis on a subprogram as soon as the end of the subprogram is reached, using a small stack. The stack structure would account for the "split" code case. This might work. It is possible that there is some not otherwise apparent advantage to the current full-file pass design. The parse tree has productions that provide access to a subprogram END statement "in advance". An alternative is to access this information to solve the problem. This PR implements this latter option. Differential revision: https://reviews.llvm.org/D91217 --- flang/lib/Semantics/resolve-labels.cpp | 78 ++++++++++++++++------------ flang/test/Semantics/label15.f90 | 92 ++++++++++++++++++++++++++++++++++ flang/test/Semantics/label16.f90 | 14 ++++++ 3 files changed, 151 insertions(+), 33 deletions(-) create mode 100644 flang/test/Semantics/label15.f90 create mode 100644 flang/test/Semantics/label16.f90 diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp index d68812b..9560a34 100644 --- a/flang/lib/Semantics/resolve-labels.cpp +++ b/flang/lib/Semantics/resolve-labels.cpp @@ -190,44 +190,57 @@ const parser::CharBlock *GetStmtName(const parser::Statement &stmt) { return nullptr; } -using ExecutableConstructEndStmts = std::tuple; - -template -static constexpr bool IsExecutableConstructEndStmt{ - common::HasMember}; - class ParseTreeAnalyzer { public: ParseTreeAnalyzer(ParseTreeAnalyzer &&that) = default; ParseTreeAnalyzer(SemanticsContext &context) : context_{context} {} - template constexpr bool Pre(const A &) { return true; } + template constexpr bool Pre(const A &x) { + using LabeledProgramUnitStmts = + std::tuple; + if constexpr (common::HasMember) { + const auto &endStmt{std::get - 1>(x.t)}; + if (endStmt.label) { + // The END statement for a subprogram appears after any internal + // subprograms. Visit that statement in advance so that results + // are placed in the correct programUnits_ slot. + auto targetFlags{ConstructBranchTargetFlags(endStmt)}; + AddTargetLabelDefinition( + endStmt.label.value(), targetFlags, currentScope_); + } + } + return true; + } template constexpr void Post(const A &) {} template bool Pre(const parser::Statement &statement) { currentPosition_ = statement.source; - if (statement.label) { - auto label{statement.label.value()}; - auto targetFlags{ConstructBranchTargetFlags(statement)}; - if constexpr (std::is_same_v || - std::is_same_v || - std::is_same_v || - std::is_same_v || - std::is_same_v || - std::is_same_v || - std::is_same_v || - std::is_same_v || - std::is_same_v) { - constexpr bool useParent{true}; - AddTargetLabelDefinition( - useParent, label, targetFlags, IsExecutableConstructEndStmt); - } else { - constexpr bool useParent{false}; - AddTargetLabelDefinition( - useParent, label, targetFlags, IsExecutableConstructEndStmt); - } + const auto &label = statement.label; + if (!label) { + return true; + } + using LabeledConstructStmts = std::tuple; + using LabeledConstructEndStmts = + std::tuple; + using LabeledProgramUnitEndStmts = + std::tuple; + auto targetFlags{ConstructBranchTargetFlags(statement)}; + if constexpr (common::HasMember) { + AddTargetLabelDefinition(label.value(), targetFlags, ParentScope()); + } else if constexpr (common::HasMember) { + constexpr bool isExecutableConstructEndStmt{true}; + AddTargetLabelDefinition(label.value(), targetFlags, currentScope_, + isExecutableConstructEndStmt); + } else if constexpr (!common::HasMember) { + // Program unit END statements have already been processed. + AddTargetLabelDefinition(label.value(), targetFlags, currentScope_); } return true; } @@ -740,13 +753,12 @@ private: } // 6.2.5., paragraph 2 - void AddTargetLabelDefinition(bool useParent, parser::Label label, + void AddTargetLabelDefinition(parser::Label label, LabeledStmtClassificationSet labeledStmtClassificationSet, - bool isExecutableConstructEndStmt) { + ProxyForScope scope, bool isExecutableConstructEndStmt = false) { CheckLabelInRange(label); const auto pair{programUnits_.back().targetStmts.emplace(label, - LabeledStatementInfoTuplePOD{ - (useParent ? ParentScope() : currentScope_), currentPosition_, + LabeledStatementInfoTuplePOD{scope, currentPosition_, labeledStmtClassificationSet, isExecutableConstructEndStmt})}; if (!pair.second) { context_.Say(currentPosition_, diff --git a/flang/test/Semantics/label15.f90 b/flang/test/Semantics/label15.f90 new file mode 100644 index 0000000..a26a68c --- /dev/null +++ b/flang/test/Semantics/label15.f90 @@ -0,0 +1,92 @@ +! RUN: %f18 -funparse %s 2>&1 | FileCheck %s + +!CHECK-NOT: error: +module mm + interface + module subroutine m(n) + end + end interface +end module mm + +program p + use mm +20 print*, 'p' +21 call p1 +22 call p2 +23 f0 = f(0); print '(f5.1)', f0 +24 f1 = f(1); print '(f5.1)', f1 +25 call s(0); call s(1) +26 call m(0); call m(1) +27 if (.false.) goto 29 +28 print*, 'px' +contains + subroutine p1 + print*, 'p1' + goto 29 +29 end subroutine p1 + subroutine p2 + print*, 'p2' + goto 29 +29 end subroutine p2 +29 end + +function f(n) + print*, 'f' +31 call f1 +32 call f2 + f = 30. + if (n == 0) goto 39 + f = f + 3. + print*, 'fx' +contains + subroutine f1 + print*, 'f1' + goto 39 +39 end subroutine f1 + subroutine f2 + print*, 'f2' + goto 39 +39 end subroutine f2 +39 end + +subroutine s(n) + print*, 's' +41 call s1 +42 call s2 +43 call s3 + if (n == 0) goto 49 + print*, 'sx' +contains + subroutine s1 + print*, 's1' + goto 49 +49 end subroutine s1 + subroutine s2 + print*, 's2' + goto 49 +49 end subroutine s2 + subroutine s3 + print*, 's3' + goto 49 +49 end subroutine s3 +49 end + +submodule(mm) mm1 +contains + module procedure m + print*, 'm' + 50 call m1 + 51 call m2 + if (n == 0) goto 59 + print*, 'mx' + contains + subroutine m1 + print*, 'm1' + goto 59 + 59 end subroutine m1 + subroutine m2 + print*, 'm2' + goto 59 + 59 end subroutine m2 + 59 end procedure m +end submodule mm1 diff --git a/flang/test/Semantics/label16.f90 b/flang/test/Semantics/label16.f90 new file mode 100644 index 0000000..11c5381 --- /dev/null +++ b/flang/test/Semantics/label16.f90 @@ -0,0 +1,14 @@ +! RUN: %S/test_errors.sh %s %t %f18 + +subroutine x(n) + call x1(n) + if (n == 0) goto 88 + print*, 'x' +contains + subroutine x1(n) + if (n == 0) goto 77 ! ok + print*, 'x1' + !ERROR: Label '88' was not found + goto 88 +77 end subroutine x1 +88 end -- 2.7.4