forked from OSchip/llvm-project
[flang] Semantics checker for STOP and ERROR STOP statements.
This commit introduces a new checker (StopChecker) for STOP and ERROR STOP Fortran statements along with a test code. Signed-off-by: Paul Osmialowski <pawel.osmialowski@arm.com> Original-commit: flang-compiler/f18@c554174562 Reviewed-on: https://github.com/flang-compiler/f18/pull/367 Tree-same-pre-rewrite: false
This commit is contained in:
Paul Osmialowski
GitHub
parent
0e28b6789e
commit
d1e409ab09
|
|
@ -24,6 +24,7 @@ add_library(FortranSemantics
|
|||
check-if-stmt.cc
|
||||
check-nullify.cc
|
||||
check-return.cc
|
||||
check-stop.cc
|
||||
expression.cc
|
||||
mod-file.cc
|
||||
resolve-labels.cc
|
||||
|
|
|
|||
|
|
@ -0,0 +1,82 @@
|
|||
// Copyright (c) 2019, Arm Ltd. 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 "check-stop.h"
|
||||
#include "semantics.h"
|
||||
#include "tools.h"
|
||||
#include "../common/Fortran.h"
|
||||
#include "../evaluate/expression.h"
|
||||
#include "../parser/parse-tree.h"
|
||||
#include <optional>
|
||||
|
||||
Fortran::semantics::StopChecker::StopChecker(
|
||||
Fortran::semantics::SemanticsContext &context)
|
||||
: context_{context} {}
|
||||
|
||||
Fortran::semantics::StopChecker::~StopChecker() = default;
|
||||
|
||||
void Fortran::semantics::StopChecker::Enter(
|
||||
const Fortran::parser::StopStmt &stmt) {
|
||||
const auto &sc{std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)};
|
||||
const auto &sle{
|
||||
std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)};
|
||||
|
||||
if (sc.has_value()) {
|
||||
const Fortran::parser::CharBlock &source{sc.value().v.thing.source};
|
||||
const auto &expr = *(sc.value().v.thing.typedExpr);
|
||||
|
||||
if (!(Fortran::semantics::ExprIsScalar(expr))) {
|
||||
context_.Say(source, "Stop code must be a scalar"_err_en_US);
|
||||
} else {
|
||||
if (Fortran::semantics::ExprHasTypeCategory(
|
||||
expr, Fortran::common::TypeCategory::Integer)) {
|
||||
// C1171 default kind
|
||||
if (!(Fortran::semantics::ExprHasTypeKind(expr,
|
||||
context_.defaultKinds().GetDefaultKind(
|
||||
Fortran::common::TypeCategory::Integer)))) {
|
||||
context_.Say(
|
||||
source, "Integer stop code must be of default kind"_err_en_US);
|
||||
}
|
||||
} else if (Fortran::semantics::ExprHasTypeCategory(
|
||||
expr, Fortran::common::TypeCategory::Character)) {
|
||||
// R1162 spells scalar-DEFAULT-char-expr
|
||||
if (!(Fortran::semantics::ExprHasTypeKind(expr,
|
||||
context_.defaultKinds().GetDefaultKind(
|
||||
Fortran::common::TypeCategory::Character)))) {
|
||||
context_.Say(
|
||||
source, "Character stop code must be of default kind"_err_en_US);
|
||||
}
|
||||
} else {
|
||||
context_.Say(
|
||||
source, "Stop code must be of INTEGER or CHARACTER type"_err_en_US);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (sle.has_value()) {
|
||||
const Fortran::parser::CharBlock &source{
|
||||
sle.value().thing.thing.value().source};
|
||||
const auto &expr = *(sle.value().thing.thing.value().typedExpr);
|
||||
|
||||
if (!(Fortran::semantics::ExprIsScalar(expr))) {
|
||||
context_.Say(source,
|
||||
"The optional QUIET parameter value must be a scalar"_err_en_US);
|
||||
} else {
|
||||
if (!(Fortran::semantics::ExprHasTypeCategory(
|
||||
expr, Fortran::common::TypeCategory::Logical))) {
|
||||
context_.Say(source,
|
||||
"The optional QUIET parameter value must be of LOGICAL type"_err_en_US);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
// Copyright (c) 2019, Arm Ltd. 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_STOP_H_
|
||||
#define FORTRAN_SEMANTICS_CHECK_STOP_H_
|
||||
|
||||
#include "semantics.h"
|
||||
|
||||
namespace Fortran::parser {
|
||||
struct StopStmt;
|
||||
}
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
||||
// Semantic analysis of STOP and ERROR STOP statements.
|
||||
class StopChecker : public virtual BaseChecker {
|
||||
public:
|
||||
explicit StopChecker(SemanticsContext &);
|
||||
~StopChecker();
|
||||
|
||||
void Enter(const parser::StopStmt &);
|
||||
|
||||
private:
|
||||
SemanticsContext &context_;
|
||||
};
|
||||
|
||||
} // namespace Fortran::semantics
|
||||
|
||||
#endif // FORTRAN_SEMANTICS_CHECK_STOP_H_
|
||||
|
|
@ -23,6 +23,7 @@
|
|||
#include "check-if-stmt.h"
|
||||
#include "check-nullify.h"
|
||||
#include "check-return.h"
|
||||
#include "check-stop.h"
|
||||
#include "expression.h"
|
||||
#include "mod-file.h"
|
||||
#include "resolve-labels.h"
|
||||
|
|
@ -82,7 +83,7 @@ using StatementSemanticsPass1 = ExprChecker;
|
|||
using StatementSemanticsPass2 =
|
||||
SemanticsVisitor<ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker,
|
||||
ComputedGotoStmtChecker, DeallocateChecker, DoConcurrentChecker,
|
||||
IfStmtChecker, NullifyChecker, ReturnStmtChecker>;
|
||||
IfStmtChecker, NullifyChecker, ReturnStmtChecker, StopChecker>;
|
||||
|
||||
SemanticsContext::SemanticsContext(
|
||||
const common::IntrinsicTypeDefaultKinds &defaultKinds,
|
||||
|
|
|
|||
|
|
@ -280,4 +280,12 @@ bool ExprHasTypeCategory(const evaluate::GenericExprWrapper &expr,
|
|||
auto dynamicType{expr.v.GetType()};
|
||||
return dynamicType.has_value() && dynamicType->category == type;
|
||||
}
|
||||
bool ExprHasTypeKind(const evaluate::GenericExprWrapper &expr, int kind) {
|
||||
auto dynamicType{expr.v.GetType()};
|
||||
return dynamicType.has_value() && dynamicType->kind == kind;
|
||||
}
|
||||
|
||||
bool ExprIsScalar(const evaluate::GenericExprWrapper &expr) {
|
||||
return !(expr.v.Rank() > 0);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -98,5 +98,7 @@ const Symbol *FindExternallyVisibleObject(
|
|||
|
||||
bool ExprHasTypeCategory(
|
||||
const evaluate::GenericExprWrapper &expr, const common::TypeCategory &type);
|
||||
bool ExprHasTypeKind(const evaluate::GenericExprWrapper &expr, int kind);
|
||||
bool ExprIsScalar(const evaluate::GenericExprWrapper &expr);
|
||||
}
|
||||
#endif // FORTRAN_SEMANTICS_TOOLS_H_
|
||||
|
|
|
|||
|
|
@ -78,6 +78,7 @@ set(ERROR_TESTS
|
|||
resolve49.f90
|
||||
resolve50.f90
|
||||
resolve51.f90
|
||||
stop01.f90
|
||||
structconst01.f90
|
||||
structconst02.f90
|
||||
structconst03.f90
|
||||
|
|
|
|||
|
|
@ -0,0 +1,119 @@
|
|||
! Copyright (c) 2019, Arm Ltd. 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.
|
||||
|
||||
program main
|
||||
implicit none
|
||||
integer :: i = -1
|
||||
integer, pointer :: p_i
|
||||
integer(kind = 1) :: invalid = 0
|
||||
integer, dimension(1:100) :: iarray
|
||||
integer, dimension(1:100), pointer :: p_iarray
|
||||
integer, allocatable, dimension(1:100) :: aiarray
|
||||
logical :: l = .false.
|
||||
logical, dimension(1:100) :: larray
|
||||
logical, allocatable, dimension(1:100) :: alarray
|
||||
character(len = 128) :: chr1
|
||||
character(kind = 4, len = 128) :: chr2
|
||||
|
||||
if (i .eq. 0) stop "Stop."
|
||||
!ERROR: Stop code must be of INTEGER or CHARACTER type
|
||||
if (i .eq. 0) stop "Stop."(1:4)
|
||||
if (i .eq. 0) stop chr1
|
||||
!ERROR: Character stop code must be of default kind
|
||||
if (i .eq. 0) stop chr2
|
||||
if (i .eq. 0) stop 1
|
||||
if (i .eq. 0) stop 1 + 2
|
||||
if (i .eq. 0) stop i
|
||||
if (i .eq. 0) stop p_i
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) stop p_iarray
|
||||
if (i .eq. 0) stop p_iarray(1)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) stop p_iarray(1:4)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) stop iarray
|
||||
if (i .eq. 0) stop iarray(1)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) stop iarray(1:4)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) stop aiarray
|
||||
if (i .eq. 0) stop aiarray(1)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) stop aiarray(1:4)
|
||||
if (i .eq. 0) stop 1 + i
|
||||
!ERROR: Integer stop code must be of default kind
|
||||
if (i .eq. 0) stop invalid
|
||||
!ERROR: Stop code must be of INTEGER or CHARACTER type
|
||||
if (i .eq. 0) stop 12.34
|
||||
if (i .eq. 0) stop 1, quiet = .true.
|
||||
if (i .eq. 0) stop 2, quiet = .false.
|
||||
if (i .eq. 0) stop 3, quiet = l
|
||||
if (i .eq. 0) stop 3, quiet = .not. l
|
||||
!ERROR: The optional QUIET parameter value must be a scalar
|
||||
if (i .eq. 0) stop 3, quiet = larray
|
||||
if (i .eq. 0) stop 3, quiet = larray(1)
|
||||
!ERROR: The optional QUIET parameter value must be a scalar
|
||||
if (i .eq. 0) stop 3, quiet = larray(1:4)
|
||||
!ERROR: The optional QUIET parameter value must be a scalar
|
||||
if (i .eq. 0) stop 3, quiet = alarray
|
||||
!ERROR: The optional QUIET parameter value must be of LOGICAL type
|
||||
if (i .eq. 0) stop 1, quiet = "Quiet."
|
||||
!ERROR: The optional QUIET parameter value must be of LOGICAL type
|
||||
if (i .eq. 0) stop 1, quiet = "Quiet."(1:4)
|
||||
if (i .eq. 0) stop , quiet = .false.
|
||||
if (i .eq. 0) error stop "Error."
|
||||
if (i .eq. 0) error stop chr1
|
||||
!ERROR: Character stop code must be of default kind
|
||||
if (i .eq. 0) error stop chr2
|
||||
if (i .eq. 0) error stop 1
|
||||
if (i .eq. 0) error stop i
|
||||
if (i .eq. 0) error stop p_i
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) error stop p_iarray
|
||||
if (i .eq. 0) error stop p_iarray(1)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) error stop p_iarray(1:4)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) error stop iarray
|
||||
if (i .eq. 0) error stop iarray(1)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) error stop iarray(1:4)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) error stop aiarray
|
||||
if (i .eq. 0) error stop aiarray(1)
|
||||
!ERROR: Stop code must be a scalar
|
||||
if (i .eq. 0) error stop aiarray(1:4)
|
||||
if (i .eq. 0) error stop 1 + i
|
||||
!ERROR: Integer stop code must be of default kind
|
||||
if (i .eq. 0) error stop invalid
|
||||
!ERROR: Stop code must be of INTEGER or CHARACTER type
|
||||
if (i .eq. 0) error stop 12.34
|
||||
if (i .eq. 0) error stop 1, quiet = .true.
|
||||
if (i .eq. 0) error stop 2, quiet = .false.
|
||||
if (i .eq. 0) error stop 3, quiet = l
|
||||
if (i .eq. 0) error stop 3, quiet = .not. l
|
||||
!ERROR: The optional QUIET parameter value must be a scalar
|
||||
if (i .eq. 0) error stop 3, quiet = larray
|
||||
if (i .eq. 0) error stop 3, quiet = larray(1)
|
||||
!ERROR: The optional QUIET parameter value must be a scalar
|
||||
if (i .eq. 0) error stop 3, quiet = larray(1:4)
|
||||
!ERROR: The optional QUIET parameter value must be a scalar
|
||||
if (i .eq. 0) error stop 3, quiet = alarray
|
||||
!ERROR: The optional QUIET parameter value must be of LOGICAL type
|
||||
if (i .eq. 0) error stop 1, quiet = "Quiet."
|
||||
!ERROR: The optional QUIET parameter value must be of LOGICAL type
|
||||
if (i .eq. 0) error stop 1, quiet = "Quiet."(1:4)
|
||||
if (i .eq. 0) error stop , quiet = .false.
|
||||
stop
|
||||
end program
|
||||
Loading…
Reference in New Issue