[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 (file)
--- 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 (file)
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<parser::Expr>(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 (file)
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<ArithmeticIfStmtContext> 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 (file)
--- 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<parser::ScalarLogicalExpr>(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 (file)
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<parser::Statement<parser::IfThenStmt>>(ifConstruct.t)
+            .statement};
+    auto &ifThenExpr{
+        std::get<parser::ScalarLogicalExpr>(ifThenStmt.t).thing.thing.value()};
+    CheckScalarLogicalExpr(ifThenExpr, messages_);
+    for (const auto &elseIfBlock :
+        std::get<std::list<parser::IfConstruct::ElseIfBlock>>(ifConstruct.t)) {
+      auto &elseIfStmt{
+          std::get<parser::Statement<parser::ElseIfStmt>>(elseIfBlock.t)
+              .statement};
+      auto &elseIfExpr{std::get<parser::ScalarLogicalExpr>(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 (file)
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<IfConstructContext> 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 (file)
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<class T> void suppress_unused_variable_warning(const T &) {}
+
+  void Check(const parser::IfStmt &ifStmt) {
+    // R1139 Check for a scalar logical expression
+    auto &expr{
+        std::get<parser::ScalarLogicalExpr>(ifStmt.t).thing.thing.value()};
+    CheckScalarLogicalExpr(expr, messages_);
+    // C1143 Check that the action stmt is not an if stmt
+    auto &actionStmt{std::get<parser::ActionStmt>(ifStmt.t)};
+    if (auto *actionIfStmt{
+            std::get_if<common::Indirection<parser::IfStmt>>(&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<Fortran::semantics::IfStmtContext>;

diff --git a/flang/lib/semantics/check-if-stmt.h b/flang/lib/semantics/check-if-stmt.h
new file mode 100644 (file)
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<IfStmtContext> 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 (file)
--- 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<ExprChecker>;
-using StatementSemanticsPass2 =
-    SemanticsVisitor<AssignmentChecker, DoConcurrentChecker>;
+using StatementSemanticsPass2 = SemanticsVisitor<ArithmeticIfStmtChecker,
+    AssignmentChecker, DoConcurrentChecker, IfConstructChecker, IfStmtChecker>;
 
-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 (file)
--- 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 <algorithm>
 #include <set>
@@ -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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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