From: Steve Scalpone Date: Tue, 26 Mar 2019 07:33:03 +0000 (-0700) Subject: [flang] Implement semantic checks for if statements, if constructs and X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=f01caa38334c9c812207cc3a9654f16af311f2f6;p=platform%2Fupstream%2Fllvm.git [flang] Implement semantic checks for if statements, if constructs and arithmetic ifs. Original-commit: flang-compiler/f18@deb2726aad63b9bc4c7d35872b4b4279fbcc78f8 Reviewed-on: https://github.com/flang-compiler/f18/pull/356 Tree-same-pre-rewrite: false --- diff --git a/flang/lib/semantics/CMakeLists.txt b/flang/lib/semantics/CMakeLists.txt index 459b71b..4b380ce 100644 --- a/flang/lib/semantics/CMakeLists.txt +++ b/flang/lib/semantics/CMakeLists.txt @@ -16,7 +16,10 @@ add_library(FortranSemantics assignment.cc attr.cc canonicalize-do.cc + check-arithmeticif.cc check-do-concurrent.cc + check-if-construct.cc + check-if-stmt.cc expression.cc mod-file.cc resolve-labels.cc diff --git a/flang/lib/semantics/check-arithmeticif.cc b/flang/lib/semantics/check-arithmeticif.cc new file mode 100644 index 0000000..9a647b0 --- /dev/null +++ b/flang/lib/semantics/check-arithmeticif.cc @@ -0,0 +1,84 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include "attr.h" +#include "check-arithmeticif.h" +#include "scope.h" +#include "semantics.h" +#include "symbol.h" +#include "tools.h" +#include "type.h" +#include "../evaluate/traversal.h" +#include "../parser/message.h" +#include "../parser/parse-tree.h" + +namespace Fortran::semantics { + +class ArithmeticIfStmtContext { +public: + ArithmeticIfStmtContext(SemanticsContext &context) + : messages_{context.messages()} {} + + bool operator==(const ArithmeticIfStmtContext &x) const { return this == &x; } + bool operator!=(const ArithmeticIfStmtContext &x) const { return this != &x; } + + // Arithmetic IF statements have been removed from Fortran 2018. + // The constraints and requirements here refer to the 2008 spec. + void Check(const parser::ArithmeticIfStmt &arithmeticIfStmt) { + // R853 Check for a scalar-numeric-expr + // C849 that shall not be of type complex. + auto &expr{std::get(arithmeticIfStmt.t)}; + if (expr.typedExpr->v.Rank() > 0) { + messages_.Say(expr.source, + "ARITHMETIC IF statement must have a scalar numeric expression"_err_en_US); + } else if (ExprHasTypeCategory( + *expr.typedExpr, common::TypeCategory::Complex)) { + messages_.Say(expr.source, + "ARITHMETIC IF statement must not have a COMPLEX expression"_err_en_US); + } else if (!IsNumericExpr(*expr.typedExpr)) { + messages_.Say(expr.source, + "ARITHMETIC IF statement must have a numeric expression"_err_en_US); + } + // The labels have already been checked in resolve-labels. + // TODO: Really? Check that they are really branch target + // statements and in the same inclusive scope. + } + +private: + bool IsNumericExpr(const evaluate::GenericExprWrapper &expr) { + auto dynamicType{expr.v.GetType()}; + return dynamicType.has_value() && + common::IsNumericTypeCategory(dynamicType->category); + } + parser::Messages &messages_; + parser::CharBlock currentStatementSourcePosition_; +}; + +} // namespace Fortran::semantics + +namespace Fortran::semantics { + +ArithmeticIfStmtChecker::ArithmeticIfStmtChecker(SemanticsContext &context) + : context_{new ArithmeticIfStmtContext{context}} {} + +ArithmeticIfStmtChecker::~ArithmeticIfStmtChecker() = default; + +void ArithmeticIfStmtChecker::Leave(const parser::ArithmeticIfStmt &x) { + context_.value().Check(x); +} + +} // namespace Fortran::semantics + +template class Fortran::common::Indirection< + Fortran::semantics::ArithmeticIfStmtContext>; diff --git a/flang/lib/semantics/check-arithmeticif.h b/flang/lib/semantics/check-arithmeticif.h new file mode 100644 index 0000000..d4ee7e3 --- /dev/null +++ b/flang/lib/semantics/check-arithmeticif.h @@ -0,0 +1,41 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#ifndef FORTRAN_SEMANTICS_CHECK_ARITHMETICIF_STMT_H_ +#define FORTRAN_SEMANTICS_CHECK_ARITHMETICIF_STMT_H_ + +#include "semantics.h" +#include "../common/indirection.h" + +namespace Fortran::parser { +struct ArithmeticIfStmt; +} +namespace Fortran::semantics { +class ArithmeticIfStmtContext; +} +extern template class Fortran::common::Indirection< + Fortran::semantics::ArithmeticIfStmtContext>; + +namespace Fortran::semantics { +class ArithmeticIfStmtChecker : public virtual BaseChecker { +public: + explicit ArithmeticIfStmtChecker(SemanticsContext &); + ~ArithmeticIfStmtChecker(); + void Leave(const parser::ArithmeticIfStmt &); + +private: + common::Indirection context_; +}; +} +#endif // FORTRAN_SEMANTICS_CHECK_ARITHMETICIF_STMT_H_ diff --git a/flang/lib/semantics/check-do-concurrent.cc b/flang/lib/semantics/check-do-concurrent.cc index 51c1275..0b20d9a 100644 --- a/flang/lib/semantics/check-do-concurrent.cc +++ b/flang/lib/semantics/check-do-concurrent.cc @@ -12,11 +12,12 @@ // See the License for the specific language governing permissions and // limitations under the License. -#include "check-do-concurrent.h" #include "attr.h" +#include "check-do-concurrent.h" #include "scope.h" #include "semantics.h" #include "symbol.h" +#include "tools.h" #include "type.h" #include "../evaluate/traversal.h" #include "../parser/message.h" @@ -438,7 +439,7 @@ public: std::get(optionalLoopControl->u) .thing.thing}; CHECK(logicalExpr.value().typedExpr); - if (!ExpressionHasTypeCategory(*logicalExpr.value().typedExpr, + if (!ExprHasTypeCategory(*logicalExpr.value().typedExpr, common::TypeCategory::Logical)) { messages_.Say(currentStatementSourcePosition_, "DO WHILE must have LOGICAL expression"_err_en_US); @@ -448,11 +449,6 @@ public: } private: - bool ExpressionHasTypeCategory(const evaluate::GenericExprWrapper &expr, - const common::TypeCategory &type) { - auto dynamicType{expr.v.GetType()}; - return dynamicType.has_value() && dynamicType->category == type; - } bool InnermostEnclosingScope(const semantics::Symbol &symbol) const { // TODO - implement return true; diff --git a/flang/lib/semantics/check-if-construct.cc b/flang/lib/semantics/check-if-construct.cc new file mode 100644 index 0000000..7f17b6e --- /dev/null +++ b/flang/lib/semantics/check-if-construct.cc @@ -0,0 +1,76 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include "attr.h" +#include "check-if-construct.h" +#include "scope.h" +#include "semantics.h" +#include "symbol.h" +#include "tools.h" +#include "type.h" +#include "../evaluate/traversal.h" +#include "../parser/message.h" +#include "../parser/parse-tree.h" + +namespace Fortran::semantics { + +class IfConstructContext { +public: + IfConstructContext(SemanticsContext &context) + : messages_{context.messages()} {} + + bool operator==(const IfConstructContext &x) const { return this == &x; } + bool operator!=(const IfConstructContext &x) const { return this != &x; } + + void Check(const parser::IfConstruct &ifConstruct) { + auto &ifThenStmt{ + std::get>(ifConstruct.t) + .statement}; + auto &ifThenExpr{ + std::get(ifThenStmt.t).thing.thing.value()}; + CheckScalarLogicalExpr(ifThenExpr, messages_); + for (const auto &elseIfBlock : + std::get>(ifConstruct.t)) { + auto &elseIfStmt{ + std::get>(elseIfBlock.t) + .statement}; + auto &elseIfExpr{std::get(elseIfStmt.t) + .thing.thing.value()}; + CheckScalarLogicalExpr(elseIfExpr, messages_); + } + // The (optional) ELSE does not have an expression to check; ignore it. + } + +private: + parser::Messages &messages_; + parser::CharBlock currentStatementSourcePosition_; +}; + +} // namespace Fortran::semantics + +namespace Fortran::semantics { + +IfConstructChecker::IfConstructChecker(SemanticsContext &context) + : context_{new IfConstructContext{context}} {} + +IfConstructChecker::~IfConstructChecker() = default; + +void IfConstructChecker::Leave(const parser::IfConstruct &x) { + context_.value().Check(x); +} + +} // namespace Fortran::semantics + +template class Fortran::common::Indirection< + Fortran::semantics::IfConstructContext>; diff --git a/flang/lib/semantics/check-if-construct.h b/flang/lib/semantics/check-if-construct.h new file mode 100644 index 0000000..2f33833 --- /dev/null +++ b/flang/lib/semantics/check-if-construct.h @@ -0,0 +1,41 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#ifndef FORTRAN_SEMANTICS_CHECK_IF_CONSTRUCT_H_ +#define FORTRAN_SEMANTICS_CHECK_IF_CONSTRUCT_H_ + +#include "semantics.h" +#include "../common/indirection.h" + +namespace Fortran::parser { +struct IfConstruct; +} +namespace Fortran::semantics { +class IfConstructContext; +} +extern template class Fortran::common::Indirection< + Fortran::semantics::IfConstructContext>; + +namespace Fortran::semantics { +class IfConstructChecker : public virtual BaseChecker { +public: + explicit IfConstructChecker(SemanticsContext &); + ~IfConstructChecker(); + void Leave(const parser::IfConstruct &); + +private: + common::Indirection context_; +}; +} +#endif // FORTRAN_SEMANTICS_CHECK_IF_CONSTRUCT_H_ diff --git a/flang/lib/semantics/check-if-stmt.cc b/flang/lib/semantics/check-if-stmt.cc new file mode 100644 index 0000000..df452c4 --- /dev/null +++ b/flang/lib/semantics/check-if-stmt.cc @@ -0,0 +1,74 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include "attr.h" +#include "check-if-stmt.h" +#include "scope.h" +#include "semantics.h" +#include "symbol.h" +#include "tools.h" +#include "type.h" +#include "../evaluate/traversal.h" +#include "../parser/message.h" +#include "../parser/parse-tree.h" + +namespace Fortran::semantics { + +class IfStmtContext { +public: + IfStmtContext(SemanticsContext &context) : messages_{context.messages()} {} + + bool operator==(const IfStmtContext &x) const { return this == &x; } + bool operator!=(const IfStmtContext &x) const { return this != &x; } + + // TODO: remove after fixing the issues that gives rise to the warning + template void suppress_unused_variable_warning(const T &) {} + + void Check(const parser::IfStmt &ifStmt) { + // R1139 Check for a scalar logical expression + auto &expr{ + std::get(ifStmt.t).thing.thing.value()}; + CheckScalarLogicalExpr(expr, messages_); + // C1143 Check that the action stmt is not an if stmt + auto &actionStmt{std::get(ifStmt.t)}; + if (auto *actionIfStmt{ + std::get_if>(&actionStmt.u)}) { + // TODO: get the source position from the action stmt + suppress_unused_variable_warning(actionIfStmt); + messages_.Say(expr.source, + "IF statement is not allowed"_err_en_US); + } + } + +private: + parser::Messages &messages_; + parser::CharBlock currentStatementSourcePosition_; +}; + +} // namespace Fortran::semantics + +namespace Fortran::semantics { + +IfStmtChecker::IfStmtChecker(SemanticsContext &context) + : context_{new IfStmtContext{context}} {} + +IfStmtChecker::~IfStmtChecker() = default; + +void IfStmtChecker::Leave(const parser::IfStmt &x) { + context_.value().Check(x); +} + +} // namespace Fortran::semantics + +template class Fortran::common::Indirection; diff --git a/flang/lib/semantics/check-if-stmt.h b/flang/lib/semantics/check-if-stmt.h new file mode 100644 index 0000000..054e3ed --- /dev/null +++ b/flang/lib/semantics/check-if-stmt.h @@ -0,0 +1,41 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#ifndef FORTRAN_SEMANTICS_CHECK_IF_STMT_H_ +#define FORTRAN_SEMANTICS_CHECK_IF_STMT_H_ + +#include "semantics.h" +#include "../common/indirection.h" + +namespace Fortran::parser { +struct IfStmt; +} +namespace Fortran::semantics { +class IfStmtContext; +} +extern template class Fortran::common::Indirection< + Fortran::semantics::IfStmtContext>; + +namespace Fortran::semantics { +class IfStmtChecker : public virtual BaseChecker { +public: + explicit IfStmtChecker(SemanticsContext &); + ~IfStmtChecker(); + void Leave(const parser::IfStmt &); + +private: + common::Indirection context_; +}; +} +#endif // FORTRAN_SEMANTICS_CHECK_IF_STMT_H_ diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index 92b3b9a..1ee8fb7 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -12,16 +12,19 @@ // See the License for the specific language governing permissions and // limitations under the License. -#include "semantics.h" #include "assignment.h" #include "canonicalize-do.h" +#include "check-arithmeticif.h" #include "check-do-concurrent.h" +#include "check-if-construct.h" +#include "check-if-stmt.h" #include "expression.h" #include "mod-file.h" #include "resolve-labels.h" #include "resolve-names.h" #include "rewrite-parse-tree.h" #include "scope.h" +#include "semantics.h" #include "symbol.h" #include "../common/default-kinds.h" #include "../parser/parse-tree-visitor.h" @@ -60,11 +63,12 @@ private: }; using StatementSemanticsPass1 = SemanticsVisitor; -using StatementSemanticsPass2 = - SemanticsVisitor; +using StatementSemanticsPass2 = SemanticsVisitor; -SemanticsContext::SemanticsContext(const common::IntrinsicTypeDefaultKinds - &defaultKinds, const parser::LanguageFeatureControl &languageFeatures) +SemanticsContext::SemanticsContext( + const common::IntrinsicTypeDefaultKinds &defaultKinds, + const parser::LanguageFeatureControl &languageFeatures) : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures}, intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds)}, foldingContext_{evaluate::FoldingContext{ @@ -159,5 +163,4 @@ static void PutIndent(std::ostream &os, int indent) { os << " "; } } - } diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index 4f3334a..0e4db9c 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -12,8 +12,8 @@ // See the License for the specific language governing permissions and // limitations under the License. -#include "tools.h" #include "scope.h" +#include "tools.h" #include "../evaluate/variable.h" #include #include @@ -87,7 +87,8 @@ bool IsUseAssociated(const Symbol &symbol, const Scope &scope) { owner != FindProgramUnitContaining(scope); } -bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent) { +bool DoesScopeContain( + const Scope *maybeAncestor, const Scope &maybeDescendent) { if (maybeAncestor != nullptr) { const Scope *scope{&maybeDescendent}; while (scope->kind() != Scope::Kind::Global) { @@ -226,4 +227,25 @@ const Symbol *FindExternallyVisibleObject( return nullptr; } } + +bool ExprHasTypeCategory(const evaluate::GenericExprWrapper &expr, + const common::TypeCategory &type) { + auto dynamicType{expr.v.GetType()}; + return dynamicType.has_value() && dynamicType->category == type; +} + +void CheckScalarLogicalExpr( + const parser::Expr &expr, parser::Messages &messages) { + // TODO: should be asserting that typedExpr is not null + if (expr.typedExpr == nullptr) { + return; + } + // TODO: Whence IsArray()? + if (expr.typedExpr->v.Rank() > 0) { + messages.Say(expr.source, "Expected a scalar LOGICAL expression"_err_en_US); + } else if (!ExprHasTypeCategory( + *expr.typedExpr, common::TypeCategory::Logical)) { + messages.Say(expr.source, "Expected a LOGICAL expression"_err_en_US); + } +} } diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index d83fe50..c768e8c 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -22,6 +22,8 @@ #include "symbol.h" #include "type.h" #include "../evaluate/variable.h" +#include "../parser/message.h" +#include "../parser/parse-tree.h" namespace Fortran::semantics { @@ -75,5 +77,10 @@ const Symbol *FindExternallyVisibleObject( [&](const auto &x) { return FindExternallyVisibleObject(x, scope); }, expr.u); } + +bool ExprHasTypeCategory( + const evaluate::GenericExprWrapper &expr, const common::TypeCategory &type); +void CheckScalarLogicalExpr( + const parser::Expr &expr, parser::Messages &messages); } #endif // FORTRAN_SEMANTICS_TOOLS_H_ diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index fb42937..670c951 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -78,6 +78,12 @@ set(ERROR_TESTS structconst03.f90 structconst04.f90 assign01.f90 + if_arith02.f90 + if_arith03.f90 + if_arith04.f90 + if_construct02.f90 + if_stmt02.f90 + if_stmt03.f90 ) # These test files have expected symbols in the source @@ -140,6 +146,12 @@ set(FORALL_TESTS forall*.[Ff]90 ) +set(IF_TESTS + if_arith01.f90 + if_construct01.f90 + if_stmt01.f90 +) + foreach(test ${ERROR_TESTS}) add_test(NAME ${test} COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/test_errors.sh ${test}) endforeach() @@ -167,3 +179,7 @@ endforeach() foreach(test ${FORALL_TESTS}) add_test(NAME ${test} COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/test_any.sh ${test}) endforeach() + +foreach(test ${IF_TESTS}) + add_test(NAME ${test} COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/test_any.sh ${test}) +endforeach() diff --git a/flang/test/semantics/if_arith01.f90 b/flang/test/semantics/if_arith01.f90 new file mode 100644 index 0000000..587189c --- /dev/null +++ b/flang/test/semantics/if_arith01.f90 @@ -0,0 +1,21 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Check that a basic arithmetic if compiles. + +if ( A ) 100, 200, 300 +100 CONTINUE +200 CONTINUE +300 CONTINUE +END diff --git a/flang/test/semantics/if_arith02.f90 b/flang/test/semantics/if_arith02.f90 new file mode 100644 index 0000000..0ce6be9 --- /dev/null +++ b/flang/test/semantics/if_arith02.f90 @@ -0,0 +1,50 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Check that only labels are allowed in arithmetic if statements. +! TODO: Revisit error message "expected 'ASSIGN'" etc. +! TODO: Revisit error message "expected one of '0123456789'" + +! TODO: BUG: Note that labels 500 and 600 do not exist and +! ought to be flagged as errors. This oversight may be the +! result of disabling semantic checking after syntax errors. + +if ( A ) 500, 600, 600 +100 CONTINUE +200 CONTINUE +300 CONTINUE + +!ERROR: expected 'ASSIGN' +!ERROR: expected 'ALLOCATE (' +!ERROR: expected '=>' +!ERROR: expected '(' +!ERROR: expected '=' +if ( B ) A, 101, 301 +101 CONTINUE +201 CONTINUE +301 CONTINUE + +!ERROR: expected one of '0123456789' +if ( B ) 102, A, 302 +102 CONTINUE +202 CONTINUE +302 CONTINUE + +!ERROR: expected one of '0123456789' +if ( B ) 103, 103, A +103 CONTINUE +203 CONTINUE +303 CONTINUE + +END diff --git a/flang/test/semantics/if_arith03.f90 b/flang/test/semantics/if_arith03.f90 new file mode 100644 index 0000000..5eb01c6 --- /dev/null +++ b/flang/test/semantics/if_arith03.f90 @@ -0,0 +1,35 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + + + +!ERROR: label '600' was not found +if ( A ) 100, 200, 600 +100 CONTINUE +200 CONTINUE +300 CONTINUE + +!ERROR: label '601' was not found +if ( A ) 101, 601, 301 +101 CONTINUE +201 CONTINUE +301 CONTINUE + +!ERROR: label '602' was not found +if ( A ) 602, 202, 302 +102 CONTINUE +202 CONTINUE +302 CONTINUE + +END diff --git a/flang/test/semantics/if_arith04.f90 b/flang/test/semantics/if_arith04.f90 new file mode 100644 index 0000000..37d8a64 --- /dev/null +++ b/flang/test/semantics/if_arith04.f90 @@ -0,0 +1,45 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Make sure arithmetic if expressions are non-complex numeric exprs. + +INTEGER I +COMPLEX Z +LOGICAL L +INTEGER, DIMENSION (2) :: B + +if ( I ) 100, 200, 300 +100 CONTINUE +200 CONTINUE +300 CONTINUE + +!ERROR: ARITHMETIC IF statement must not have a COMPLEX expression +if ( Z ) 101, 201, 301 +101 CONTINUE +201 CONTINUE +301 CONTINUE + +!ERROR: ARITHMETIC IF statement must have a numeric expression +if ( L ) 102, 202, 302 +102 CONTINUE +202 CONTINUE +302 CONTINUE + +!ERROR: ARITHMETIC IF statement must have a scalar numeric expression +if ( B ) 103, 203, 303 +103 CONTINUE +203 CONTINUE +303 CONTINUE + +END diff --git a/flang/test/semantics/if_construct01.f90 b/flang/test/semantics/if_construct01.f90 new file mode 100644 index 0000000..a67a6c1 --- /dev/null +++ b/flang/test/semantics/if_construct01.f90 @@ -0,0 +1,57 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Simple check that if iconstructs are ok. + +if (a < b) then + a = 1 +end if + +if (a < b) then + a = 2 +else + a = 3 +endif + +if (a < b) then + a = 4 +else if(a == b) then + a = 5 +end if + +if (a < b) then + a = 6 +else if(a == b) then + a = 7 +elseif(a > b) then + a = 8 +end if + +if (a < b) then + a = 9 +else if(a == b) then + a = 10 +else + a = 11 +end if + +if (a < b) then + a = 12 +else if(a == b) then + a = 13 +else if(a > b) then + a = 14 +end if + +end diff --git a/flang/test/semantics/if_construct02.f90 b/flang/test/semantics/if_construct02.f90 new file mode 100644 index 0000000..bcddb00 --- /dev/null +++ b/flang/test/semantics/if_construct02.f90 @@ -0,0 +1,126 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Check that if constructs only accept scalar logical expressions. +! TODO: expand the test to check this restriction for more types. + +INTEGER :: I +LOGICAL, DIMENSION (2) :: B + +!ERROR: Expected a scalar LOGICAL expression +if ( B ) then + a = 1 +end if + +!ERROR: Expected a scalar LOGICAL expression +if ( B ) then + a = 2 +else + a = 3 +endif + +!ERROR: Expected a scalar LOGICAL expression +if ( B ) then + a = 4 +!ERROR: Expected a scalar LOGICAL expression +else if( B ) then + a = 5 +end if + +!ERROR: Expected a scalar LOGICAL expression +if ( B ) then + a = 6 +!ERROR: Expected a scalar LOGICAL expression +else if( B ) then + a = 7 +!ERROR: Expected a scalar LOGICAL expression +elseif( B ) then + a = 8 +end if + +!ERROR: Expected a scalar LOGICAL expression +if ( B ) then + a = 9 +!ERROR: Expected a scalar LOGICAL expression +else if( B ) then + a = 10 +else + a = 11 +end if + +!ERROR: Expected a scalar LOGICAL expression +if ( B ) then + a = 12 +!ERROR: Expected a scalar LOGICAL expression +else if( B ) then + a = 13 +!ERROR: Expected a scalar LOGICAL expression +else if( B ) then + a = 14 +end if + + +!ERROR: Expected a LOGICAL expression +if ( I ) then + a = 1 +end if + +!ERROR: Expected a LOGICAL expression +if ( I ) then + a = 2 +else + a = 3 +endif + +!ERROR: Expected a LOGICAL expression +if ( I ) then + a = 4 +!ERROR: Expected a LOGICAL expression +else if( I ) then + a = 5 +end if + +!ERROR: Expected a LOGICAL expression +if ( I ) then + a = 6 +!ERROR: Expected a LOGICAL expression +else if( I ) then + a = 7 +!ERROR: Expected a LOGICAL expression +elseif( I ) then + a = 8 +end if + +!ERROR: Expected a LOGICAL expression +if ( I ) then + a = 9 +!ERROR: Expected a LOGICAL expression +else if( I ) then + a = 10 +else + a = 11 +end if + +!ERROR: Expected a LOGICAL expression +if ( I ) then + a = 12 +!ERROR: Expected a LOGICAL expression +else if( I ) then + a = 13 +!ERROR: Expected a LOGICAL expression +else if( I ) then + a = 14 +end if + +end diff --git a/flang/test/semantics/if_stmt01.f90 b/flang/test/semantics/if_stmt01.f90 new file mode 100644 index 0000000..aab6718 --- /dev/null +++ b/flang/test/semantics/if_stmt01.f90 @@ -0,0 +1,18 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Simple check that if statements are ok. + +IF (A > 0.0) A = LOG (A) +END diff --git a/flang/test/semantics/if_stmt02.f90 b/flang/test/semantics/if_stmt02.f90 new file mode 100644 index 0000000..6e70f89 --- /dev/null +++ b/flang/test/semantics/if_stmt02.f90 @@ -0,0 +1,17 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +!ERROR: IF statement is not allowed +IF (A > 0.0) IF (B < 0.0) A = LOG (A) +END diff --git a/flang/test/semantics/if_stmt03.f90 b/flang/test/semantics/if_stmt03.f90 new file mode 100644 index 0000000..d8200c6 --- /dev/null +++ b/flang/test/semantics/if_stmt03.f90 @@ -0,0 +1,26 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Check that non-logical expressions are not allowed. +! Check that non-scalar expressions are not allowed. +! TODO: Insure all non-logicals are prohibited. + +LOGICAL, DIMENSION (2) :: B + +!ERROR: Expected a LOGICAL expression +IF (A) A = LOG (A) +!ERROR: Expected a scalar LOGICAL expression +IF (B) A = LOG (A) + +END