2020-02-25 23:11:52 +08:00
|
|
|
//===-- lib/Semantics/check-allocate.cpp ----------------------------------===//
|
2019-04-19 00:17:31 +08:00
|
|
|
//
|
2019-12-21 04:52:07 +08:00
|
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
2019-04-19 00:17:31 +08:00
|
|
|
//
|
2020-01-11 04:12:03 +08:00
|
|
|
//===----------------------------------------------------------------------===//
|
2019-04-19 00:17:31 +08:00
|
|
|
|
|
|
|
#include "check-allocate.h"
|
2019-11-20 11:10:02 +08:00
|
|
|
#include "assignment.h"
|
2020-02-25 23:11:52 +08:00
|
|
|
#include "flang/Evaluate/fold.h"
|
|
|
|
#include "flang/Evaluate/type.h"
|
|
|
|
#include "flang/Parser/parse-tree.h"
|
|
|
|
#include "flang/Parser/tools.h"
|
|
|
|
#include "flang/Semantics/attr.h"
|
|
|
|
#include "flang/Semantics/expression.h"
|
|
|
|
#include "flang/Semantics/tools.h"
|
|
|
|
#include "flang/Semantics/type.h"
|
2019-04-19 00:17:31 +08:00
|
|
|
|
|
|
|
namespace Fortran::semantics {
|
|
|
|
|
|
|
|
struct AllocateCheckerInfo {
|
|
|
|
const DeclTypeSpec *typeSpec{nullptr};
|
|
|
|
std::optional<evaluate::DynamicType> sourceExprType;
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
std::optional<parser::CharBlock> sourceExprLoc;
|
|
|
|
std::optional<parser::CharBlock> typeSpecLoc;
|
2020-03-29 12:00:16 +08:00
|
|
|
int sourceExprRank{0}; // only valid if gotMold || gotSource
|
2019-04-19 00:17:31 +08:00
|
|
|
bool gotStat{false};
|
|
|
|
bool gotMsg{false};
|
|
|
|
bool gotTypeSpec{false};
|
2019-11-20 11:10:02 +08:00
|
|
|
bool gotSource{false};
|
2019-04-19 00:17:31 +08:00
|
|
|
bool gotMold{false};
|
|
|
|
};
|
|
|
|
|
2019-04-23 20:57:50 +08:00
|
|
|
class AllocationCheckerHelper {
|
2019-04-19 00:17:31 +08:00
|
|
|
public:
|
2019-04-23 20:57:50 +08:00
|
|
|
AllocationCheckerHelper(
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
const parser::Allocation &alloc, AllocateCheckerInfo &info)
|
2020-03-29 12:00:16 +08:00
|
|
|
: allocateInfo_{info}, allocateObject_{std::get<parser::AllocateObject>(
|
|
|
|
alloc.t)},
|
|
|
|
name_{parser::GetLastName(allocateObject_)},
|
|
|
|
symbol_{name_.symbol ? &name_.symbol->GetUltimate() : nullptr},
|
|
|
|
type_{symbol_ ? symbol_->GetType() : nullptr},
|
|
|
|
allocateShapeSpecRank_{ShapeSpecRank(alloc)}, rank_{symbol_
|
|
|
|
? symbol_->Rank()
|
|
|
|
: 0},
|
|
|
|
allocateCoarraySpecRank_{CoarraySpecRank(alloc)},
|
|
|
|
corank_{symbol_ ? symbol_->Corank() : 0} {}
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
|
|
|
|
bool RunChecks(SemanticsContext &context);
|
|
|
|
|
|
|
|
private:
|
|
|
|
bool hasAllocateShapeSpecList() const { return allocateShapeSpecRank_ != 0; }
|
|
|
|
bool hasAllocateCoarraySpec() const { return allocateCoarraySpecRank_ != 0; }
|
|
|
|
bool RunCoarrayRelatedChecks(SemanticsContext &) const;
|
|
|
|
|
|
|
|
static int ShapeSpecRank(const parser::Allocation &allocation) {
|
|
|
|
return static_cast<int>(
|
|
|
|
std::get<std::list<parser::AllocateShapeSpec>>(allocation.t).size());
|
|
|
|
}
|
|
|
|
|
|
|
|
static int CoarraySpecRank(const parser::Allocation &allocation) {
|
|
|
|
if (const auto &coarraySpec{
|
|
|
|
std::get<std::optional<parser::AllocateCoarraySpec>>(
|
|
|
|
allocation.t)}) {
|
|
|
|
return std::get<std::list<parser::AllocateCoshapeSpec>>(coarraySpec->t)
|
|
|
|
.size() +
|
|
|
|
1;
|
|
|
|
} else {
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void GatherAllocationBasicInfo() {
|
2019-05-03 16:31:48 +08:00
|
|
|
if (type_->category() == DeclTypeSpec::Category::Character) {
|
|
|
|
hasDeferredTypeParameter_ =
|
|
|
|
type_->characterTypeSpec().length().isDeferred();
|
|
|
|
} else if (const DerivedTypeSpec * derivedTypeSpec{type_->AsDerived()}) {
|
|
|
|
for (const auto &pair : derivedTypeSpec->parameters()) {
|
|
|
|
hasDeferredTypeParameter_ |= pair.second.isDeferred();
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
2019-05-03 16:31:48 +08:00
|
|
|
isAbstract_ = derivedTypeSpec->typeSymbol().attrs().test(Attr::ABSTRACT);
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
2019-05-03 16:31:48 +08:00
|
|
|
isUnlimitedPolymorphic_ =
|
|
|
|
type_->category() == DeclTypeSpec::Category::ClassStar;
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
2019-05-03 16:31:48 +08:00
|
|
|
|
|
|
|
AllocateCheckerInfo &allocateInfo_;
|
|
|
|
const parser::AllocateObject &allocateObject_;
|
|
|
|
const parser::Name &name_;
|
2019-06-05 08:03:34 +08:00
|
|
|
const Symbol *symbol_{nullptr};
|
|
|
|
const DeclTypeSpec *type_{nullptr};
|
2019-05-03 16:31:48 +08:00
|
|
|
const int allocateShapeSpecRank_;
|
2019-06-05 08:03:34 +08:00
|
|
|
const int rank_{0};
|
2019-05-03 16:31:48 +08:00
|
|
|
const int allocateCoarraySpecRank_;
|
2019-06-05 08:03:34 +08:00
|
|
|
const int corank_{0};
|
2019-05-03 16:31:48 +08:00
|
|
|
bool hasDeferredTypeParameter_{false};
|
|
|
|
bool isUnlimitedPolymorphic_{false};
|
|
|
|
bool isAbstract_{false};
|
2019-04-19 00:17:31 +08:00
|
|
|
};
|
|
|
|
|
|
|
|
static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
|
|
|
|
const parser::AllocateStmt &allocateStmt, SemanticsContext &context) {
|
|
|
|
AllocateCheckerInfo info;
|
2020-03-29 12:00:16 +08:00
|
|
|
bool stopCheckingAllocate{false}; // for errors that would lead to ambiguity
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
if (const auto &typeSpec{
|
|
|
|
std::get<std::optional<parser::TypeSpec>>(allocateStmt.t)}) {
|
|
|
|
info.typeSpec = typeSpec->declTypeSpec;
|
|
|
|
if (!info.typeSpec) {
|
|
|
|
CHECK(context.AnyFatalError());
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-05-07 23:28:24 +08:00
|
|
|
info.gotTypeSpec = true;
|
|
|
|
info.typeSpecLoc = parser::FindSourceLocation(*typeSpec);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
if (const DerivedTypeSpec * derived{info.typeSpec->AsDerived()}) {
|
|
|
|
// C937
|
2019-07-31 22:19:22 +08:00
|
|
|
if (auto it{FindCoarrayUltimateComponent(*derived)}) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context
|
2019-07-26 23:11:59 +08:00
|
|
|
.Say("Type-spec in ALLOCATE must not specify a type with a coarray"
|
|
|
|
" ultimate component"_err_en_US)
|
2019-10-23 07:53:29 +08:00
|
|
|
.Attach(it->name(),
|
2019-07-26 23:11:59 +08:00
|
|
|
"Type '%s' has coarray ultimate component '%s' declared here"_en_US,
|
2019-07-31 22:19:22 +08:00
|
|
|
info.typeSpec->AsFortran(), it.BuildResultDesignatorName());
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
}
|
|
|
|
}
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
const parser::Expr *parserSourceExpr{nullptr};
|
|
|
|
for (const parser::AllocOpt &allocOpt :
|
|
|
|
std::get<std::list<parser::AllocOpt>>(allocateStmt.t)) {
|
|
|
|
std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](const parser::StatOrErrmsg &statOrErr) {
|
|
|
|
std::visit(
|
|
|
|
common::visitors{
|
2019-08-16 04:50:27 +08:00
|
|
|
[&](const parser::StatVariable &) {
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotStat) { // C943
|
2019-04-19 00:17:31 +08:00
|
|
|
context.Say(
|
|
|
|
"STAT may not be duplicated in a ALLOCATE statement"_err_en_US);
|
|
|
|
}
|
|
|
|
info.gotStat = true;
|
|
|
|
},
|
2019-08-16 04:50:27 +08:00
|
|
|
[&](const parser::MsgVariable &) {
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotMsg) { // C943
|
2019-04-19 00:17:31 +08:00
|
|
|
context.Say(
|
|
|
|
"ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US);
|
|
|
|
}
|
|
|
|
info.gotMsg = true;
|
|
|
|
},
|
|
|
|
},
|
|
|
|
statOrErr.u);
|
|
|
|
},
|
|
|
|
[&](const parser::AllocOpt::Source &source) {
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotSource) { // C943
|
2019-04-19 00:17:31 +08:00
|
|
|
context.Say(
|
|
|
|
"SOURCE may not be duplicated in a ALLOCATE statement"_err_en_US);
|
|
|
|
stopCheckingAllocate = true;
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotMold || info.gotTypeSpec) { // C944
|
2019-04-19 00:17:31 +08:00
|
|
|
context.Say(
|
|
|
|
"At most one of source-expr and type-spec may appear in a ALLOCATE statement"_err_en_US);
|
|
|
|
stopCheckingAllocate = true;
|
|
|
|
}
|
|
|
|
parserSourceExpr = &source.v.value();
|
2019-11-20 11:10:02 +08:00
|
|
|
info.gotSource = true;
|
2019-04-19 00:17:31 +08:00
|
|
|
},
|
|
|
|
[&](const parser::AllocOpt::Mold &mold) {
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotMold) { // C943
|
2019-04-19 00:17:31 +08:00
|
|
|
context.Say(
|
|
|
|
"MOLD may not be duplicated in a ALLOCATE statement"_err_en_US);
|
|
|
|
stopCheckingAllocate = true;
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotSource || info.gotTypeSpec) { // C944
|
2019-04-19 00:17:31 +08:00
|
|
|
context.Say(
|
|
|
|
"At most one of source-expr and type-spec may appear in a ALLOCATE statement"_err_en_US);
|
|
|
|
stopCheckingAllocate = true;
|
|
|
|
}
|
|
|
|
parserSourceExpr = &mold.v.value();
|
|
|
|
info.gotMold = true;
|
|
|
|
},
|
|
|
|
},
|
|
|
|
allocOpt.u);
|
|
|
|
}
|
|
|
|
|
|
|
|
if (stopCheckingAllocate) {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-11-20 11:10:02 +08:00
|
|
|
if (info.gotSource || info.gotMold) {
|
2019-07-30 00:12:52 +08:00
|
|
|
if (const auto *expr{GetExpr(DEREF(parserSourceExpr))}) {
|
2019-11-20 11:10:02 +08:00
|
|
|
parser::CharBlock at{parserSourceExpr->source};
|
2019-04-23 20:57:50 +08:00
|
|
|
info.sourceExprType = expr->GetType();
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!info.sourceExprType) {
|
2019-11-20 11:10:02 +08:00
|
|
|
context.Say(at,
|
2019-07-26 21:39:26 +08:00
|
|
|
"Typeless item not allowed as SOURCE or MOLD in ALLOCATE"_err_en_US);
|
2019-04-23 20:57:50 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
info.sourceExprRank = expr->Rank();
|
|
|
|
info.sourceExprLoc = parserSourceExpr->source;
|
2019-12-17 06:28:23 +08:00
|
|
|
if (const DerivedTypeSpec *
|
|
|
|
derived{evaluate::GetDerivedTypeSpec(info.sourceExprType)}) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
// C949
|
2019-12-17 06:28:23 +08:00
|
|
|
if (auto it{FindCoarrayUltimateComponent(*derived)}) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context
|
2019-11-20 11:10:02 +08:00
|
|
|
.Say(at,
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
"SOURCE or MOLD expression must not have a type with a coarray ultimate component"_err_en_US)
|
2019-10-23 07:53:29 +08:00
|
|
|
.Attach(it->name(),
|
2019-07-26 23:11:59 +08:00
|
|
|
"Type '%s' has coarray ultimate component '%s' declared here"_en_US,
|
|
|
|
info.sourceExprType.value().AsFortran(),
|
2019-07-31 22:19:22 +08:00
|
|
|
it.BuildResultDesignatorName());
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
}
|
2019-11-20 11:10:02 +08:00
|
|
|
if (info.gotSource) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
// C948
|
2019-12-17 06:28:23 +08:00
|
|
|
if (IsEventTypeOrLockType(derived)) {
|
2019-11-20 11:10:02 +08:00
|
|
|
context.Say(at,
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
"SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV"_err_en_US);
|
2019-12-17 06:28:23 +08:00
|
|
|
} else if (auto it{FindEventOrLockPotentialComponent(*derived)}) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context
|
2019-11-20 11:10:02 +08:00
|
|
|
.Say(at,
|
2019-07-26 23:11:59 +08:00
|
|
|
"SOURCE expression type must not have potential subobject "
|
|
|
|
"component"
|
|
|
|
" of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV"_err_en_US)
|
2019-10-23 07:53:29 +08:00
|
|
|
.Attach(it->name(),
|
2019-07-26 23:11:59 +08:00
|
|
|
"Type '%s' has potential ultimate component '%s' declared here"_en_US,
|
|
|
|
info.sourceExprType.value().AsFortran(),
|
2019-07-31 22:19:22 +08:00
|
|
|
it.BuildResultDesignatorName());
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
if (info.gotSource) { // C1594(6) - SOURCE= restrictions when pure
|
2019-11-20 11:10:02 +08:00
|
|
|
const Scope &scope{context.FindScope(at)};
|
|
|
|
if (FindPureProcedureContaining(scope)) {
|
|
|
|
parser::ContextualMessages messages{at, &context.messages()};
|
|
|
|
CheckCopyabilityInPureScope(messages, *expr, scope);
|
|
|
|
}
|
|
|
|
}
|
2019-04-23 20:57:50 +08:00
|
|
|
} else {
|
|
|
|
// Error already reported on source expression.
|
|
|
|
// Do not continue allocate checks.
|
2019-04-19 00:17:31 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
}
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
|
2019-04-19 00:17:31 +08:00
|
|
|
return info;
|
|
|
|
}
|
|
|
|
|
|
|
|
// Beware, type compatibility is not symmetric, IsTypeCompatible checks that
|
|
|
|
// type1 is type compatible with type2. Note: type parameters are not considered
|
|
|
|
// in this test.
|
|
|
|
static bool IsTypeCompatible(
|
|
|
|
const DeclTypeSpec &type1, const DerivedTypeSpec &derivedType2) {
|
|
|
|
if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
|
|
|
|
if (type1.category() == DeclTypeSpec::Category::TypeDerived) {
|
|
|
|
return &derivedType1->typeSymbol() == &derivedType2.typeSymbol();
|
|
|
|
} else if (type1.category() == DeclTypeSpec::Category::ClassDerived) {
|
2019-11-10 01:29:31 +08:00
|
|
|
for (const DerivedTypeSpec *parent{&derivedType2}; parent;
|
2019-04-19 00:17:31 +08:00
|
|
|
parent = parent->typeSymbol().GetParentTypeSpec()) {
|
|
|
|
if (&derivedType1->typeSymbol() == &parent->typeSymbol()) {
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
|
|
|
static bool IsTypeCompatible(
|
|
|
|
const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
|
|
|
|
if (type1.category() == DeclTypeSpec::Category::ClassStar) {
|
2019-04-23 20:57:50 +08:00
|
|
|
// TypeStar does not make sense in allocate context because assumed type
|
2019-04-19 00:17:31 +08:00
|
|
|
// cannot be allocatable (C709)
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
if (const IntrinsicTypeSpec * intrinsicType2{type2.AsIntrinsic()}) {
|
|
|
|
if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) {
|
|
|
|
return intrinsicType1->category() == intrinsicType2->category();
|
|
|
|
} else {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
} else if (const DerivedTypeSpec * derivedType2{type2.AsDerived()}) {
|
|
|
|
return IsTypeCompatible(type1, *derivedType2);
|
|
|
|
}
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
|
|
|
static bool IsTypeCompatible(
|
|
|
|
const DeclTypeSpec &type1, const evaluate::DynamicType &type2) {
|
|
|
|
if (type1.category() == DeclTypeSpec::Category::ClassStar) {
|
2019-04-23 20:57:50 +08:00
|
|
|
// TypeStar does not make sense in allocate context because assumed type
|
2019-04-19 00:17:31 +08:00
|
|
|
// cannot be allocatable (C709)
|
|
|
|
return true;
|
|
|
|
}
|
2019-05-14 00:33:18 +08:00
|
|
|
if (type2.category() != evaluate::TypeCategory::Derived) {
|
2019-04-19 00:17:31 +08:00
|
|
|
if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
return intrinsicType1->category() == type2.category();
|
2019-04-19 00:17:31 +08:00
|
|
|
} else {
|
|
|
|
return false;
|
|
|
|
}
|
2019-07-20 04:50:39 +08:00
|
|
|
} else if (!type2.IsUnlimitedPolymorphic()) {
|
2019-05-14 00:33:18 +08:00
|
|
|
return IsTypeCompatible(type1, type2.GetDerivedTypeSpec());
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
|
|
|
// Note: Check assumes type1 is compatible with type2. type2 may have more type
|
|
|
|
// parameters than type1 but if a type2 type parameter is assumed, then this
|
|
|
|
// check enforce that type1 has it. type1 can be unlimited polymorphic, but not
|
|
|
|
// type2.
|
|
|
|
static bool HaveSameAssumedTypeParameters(
|
|
|
|
const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
|
|
|
|
if (type2.category() == DeclTypeSpec::Category::Character) {
|
|
|
|
bool type2LengthIsAssumed{type2.characterTypeSpec().length().isAssumed()};
|
|
|
|
if (type1.category() == DeclTypeSpec::Category::Character) {
|
|
|
|
return type1.characterTypeSpec().length().isAssumed() ==
|
|
|
|
type2LengthIsAssumed;
|
|
|
|
}
|
|
|
|
// It is possible to reach this if type1 is unlimited polymorphic
|
|
|
|
return !type2LengthIsAssumed;
|
|
|
|
} else if (const DerivedTypeSpec * derivedType2{type2.AsDerived()}) {
|
|
|
|
int type2AssumedParametersCount{0};
|
|
|
|
int type1AssumedParametersCount{0};
|
2019-04-23 20:57:50 +08:00
|
|
|
for (const auto &pair : derivedType2->parameters()) {
|
|
|
|
type2AssumedParametersCount += pair.second.isAssumed();
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
2019-04-23 21:06:33 +08:00
|
|
|
// type1 may be unlimited polymorphic
|
|
|
|
if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
|
2019-04-19 00:17:31 +08:00
|
|
|
for (auto it{derivedType1->parameters().begin()};
|
|
|
|
it != derivedType1->parameters().end(); ++it) {
|
|
|
|
if (it->second.isAssumed()) {
|
|
|
|
++type1AssumedParametersCount;
|
2019-04-23 20:57:50 +08:00
|
|
|
const ParamValue *param{derivedType2->FindParameter(it->first)};
|
|
|
|
if (!param || !param->isAssumed()) {
|
|
|
|
// type1 has an assumed parameter that is not a type parameter of
|
|
|
|
// type2 or not assumed in type2.
|
|
|
|
return false;
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
// Will return false if type2 has type parameters that are not assumed in
|
|
|
|
// type1 or do not exist in type1
|
|
|
|
return type1AssumedParametersCount == type2AssumedParametersCount;
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
return true; // other intrinsic types have no length type parameters
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static std::optional<std::int64_t> GetTypeParameterInt64Value(
|
|
|
|
const Symbol ¶meterSymbol, const DerivedTypeSpec &derivedType) {
|
|
|
|
if (const ParamValue *
|
|
|
|
paramValue{derivedType.FindParameter(parameterSymbol.name())}) {
|
|
|
|
return evaluate::ToInt64(paramValue->GetExplicit());
|
|
|
|
} else {
|
2019-05-22 23:00:19 +08:00
|
|
|
return std::nullopt;
|
2019-04-19 00:17:31 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
// HaveCompatibleKindParameters functions assume type1 is type compatible with
|
|
|
|
// type2 (except for kind type parameters)
|
|
|
|
static bool HaveCompatibleKindParameters(
|
|
|
|
const DerivedTypeSpec &derivedType1, const DerivedTypeSpec &derivedType2) {
|
2019-10-23 07:53:29 +08:00
|
|
|
for (const Symbol &symbol :
|
2019-07-11 21:29:31 +08:00
|
|
|
OrderParameterDeclarations(derivedType1.typeSymbol())) {
|
2019-10-23 07:53:29 +08:00
|
|
|
if (symbol.get<TypeParamDetails>().attr() == common::TypeParamAttr::Kind) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
// At this point, it should have been ensured that these contain integer
|
|
|
|
// constants, so die if this is not the case.
|
2019-10-23 07:53:29 +08:00
|
|
|
if (GetTypeParameterInt64Value(symbol, derivedType1).value() !=
|
|
|
|
GetTypeParameterInt64Value(symbol, derivedType2).value()) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
static bool HaveCompatibleKindParameters(
|
|
|
|
const DeclTypeSpec &type1, const evaluate::DynamicType &type2) {
|
|
|
|
if (type1.category() == DeclTypeSpec::Category::ClassStar) {
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
return evaluate::ToInt64(intrinsicType1->kind()).value() == type2.kind();
|
2019-07-20 04:50:39 +08:00
|
|
|
} else if (type2.IsUnlimitedPolymorphic()) {
|
|
|
|
return false;
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
} else if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
return HaveCompatibleKindParameters(
|
|
|
|
*derivedType1, type2.GetDerivedTypeSpec());
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
} else {
|
|
|
|
common::die("unexpected type1 category");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-04-19 00:17:31 +08:00
|
|
|
static bool HaveCompatibleKindParameters(
|
|
|
|
const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
|
|
|
|
if (type1.category() == DeclTypeSpec::Category::ClassStar) {
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) {
|
2019-07-30 00:12:52 +08:00
|
|
|
return intrinsicType1->kind() == DEREF(type2.AsIntrinsic()).kind();
|
2019-04-19 00:17:31 +08:00
|
|
|
} else if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
|
2019-07-30 00:12:52 +08:00
|
|
|
return HaveCompatibleKindParameters(
|
|
|
|
*derivedType1, DEREF(type2.AsDerived()));
|
2019-04-19 00:17:31 +08:00
|
|
|
} else {
|
|
|
|
common::die("unexpected type1 category");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-04-23 20:57:50 +08:00
|
|
|
bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!symbol_) {
|
2019-05-22 23:00:19 +08:00
|
|
|
CHECK(context.AnyFatalError());
|
2019-04-26 04:18:33 +08:00
|
|
|
return false;
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
if (!IsVariableName(*symbol_)) { // C932 pre-requisite
|
2019-04-23 20:57:50 +08:00
|
|
|
context.Say(name_.source,
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
"Name in ALLOCATE statement must be a variable name"_err_en_US);
|
2019-04-23 20:57:50 +08:00
|
|
|
return false;
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!type_) {
|
2019-05-22 23:00:19 +08:00
|
|
|
// This is done after variable check because a user could have put
|
|
|
|
// a subroutine name in allocate for instance which is a symbol with
|
|
|
|
// no type.
|
|
|
|
CHECK(context.AnyFatalError());
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
GatherAllocationBasicInfo();
|
2020-03-29 12:00:16 +08:00
|
|
|
if (!IsAllocatableOrPointer(*symbol_)) { // C932
|
2019-04-23 20:57:50 +08:00
|
|
|
context.Say(name_.source,
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
"Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
|
2019-04-23 20:57:50 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
bool gotSourceExprOrTypeSpec{allocateInfo_.gotMold ||
|
2019-11-20 11:10:02 +08:00
|
|
|
allocateInfo_.gotTypeSpec || allocateInfo_.gotSource};
|
2019-04-23 20:57:50 +08:00
|
|
|
if (hasDeferredTypeParameter_ && !gotSourceExprOrTypeSpec) {
|
|
|
|
// C933
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Either type-spec or source-expr must appear in ALLOCATE when allocatable object has a deferred type parameters"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (isUnlimitedPolymorphic_ && !gotSourceExprOrTypeSpec) {
|
|
|
|
// C933
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (isAbstract_ && !gotSourceExprOrTypeSpec) {
|
|
|
|
// C933
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (allocateInfo_.gotTypeSpec) {
|
|
|
|
if (!IsTypeCompatible(*type_, *allocateInfo_.typeSpec)) {
|
|
|
|
// C934
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Allocatable object in ALLOCATE must be type compatible with type-spec"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (!HaveCompatibleKindParameters(*type_, *allocateInfo_.typeSpec)) {
|
|
|
|
context.Say(name_.source,
|
|
|
|
// C936
|
|
|
|
"Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (!HaveSameAssumedTypeParameters(*type_, *allocateInfo_.typeSpec)) {
|
|
|
|
// C935
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Type parameters in type-spec must be assumed if and only if they are assumed for allocatable object in ALLOCATE"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
2019-11-20 11:10:02 +08:00
|
|
|
} else if (allocateInfo_.gotSource || allocateInfo_.gotMold) {
|
2019-04-23 20:57:50 +08:00
|
|
|
if (!IsTypeCompatible(*type_, allocateInfo_.sourceExprType.value())) {
|
|
|
|
// first part of C945
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
if (!HaveCompatibleKindParameters(
|
|
|
|
*type_, allocateInfo_.sourceExprType.value())) {
|
|
|
|
// C946
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
// Shape related checks
|
|
|
|
if (rank_ > 0) {
|
|
|
|
if (!hasAllocateShapeSpecList()) {
|
|
|
|
// C939
|
2019-11-20 11:10:02 +08:00
|
|
|
if (!(allocateInfo_.gotSource || allocateInfo_.gotMold)) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context.Say(name_.source,
|
|
|
|
"Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US);
|
|
|
|
return false;
|
|
|
|
} else {
|
|
|
|
if (allocateInfo_.sourceExprRank != rank_) {
|
|
|
|
context
|
|
|
|
.Say(name_.source,
|
|
|
|
"Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US)
|
|
|
|
.Attach(allocateInfo_.sourceExprLoc.value(),
|
|
|
|
"Expression in %s has rank %d but allocatable object has rank %d"_en_US,
|
2019-11-20 11:10:02 +08:00
|
|
|
allocateInfo_.gotSource ? "SOURCE" : "MOLD",
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
allocateInfo_.sourceExprRank, rank_);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
// first part of C942
|
|
|
|
if (allocateShapeSpecRank_ != rank_) {
|
|
|
|
context
|
|
|
|
.Say(name_.source,
|
|
|
|
"The number of shape specifications, when they appear, must match the rank of allocatable object"_err_en_US)
|
2019-06-05 08:03:34 +08:00
|
|
|
.Attach(symbol_->name(), "Declared here with rank %d"_en_US, rank_);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
// C940
|
|
|
|
if (hasAllocateShapeSpecList()) {
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Shape specifications must not appear when allocatable object is scalar"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
// second and last part of C945
|
2019-11-20 11:10:02 +08:00
|
|
|
if (allocateInfo_.gotSource && allocateInfo_.sourceExprRank &&
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
allocateInfo_.sourceExprRank != rank_) {
|
|
|
|
context
|
|
|
|
.Say(name_.source,
|
|
|
|
"If SOURCE appears, the related expression must be scalar or have the same rank as each allocatable object in ALLOCATE"_err_en_US)
|
|
|
|
.Attach(allocateInfo_.sourceExprLoc.value(),
|
|
|
|
"SOURCE expression has rank %d"_en_US, allocateInfo_.sourceExprRank)
|
2019-06-05 08:03:34 +08:00
|
|
|
.Attach(symbol_->name(),
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
"Allocatable object declared here with rank %d"_en_US, rank_);
|
|
|
|
return false;
|
|
|
|
}
|
2020-02-19 09:14:24 +08:00
|
|
|
context.CheckIndexVarRedefine(name_);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return RunCoarrayRelatedChecks(context);
|
|
|
|
}
|
|
|
|
|
|
|
|
bool AllocationCheckerHelper::RunCoarrayRelatedChecks(
|
|
|
|
SemanticsContext &context) const {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!symbol_) {
|
2019-06-05 08:03:34 +08:00
|
|
|
CHECK(context.AnyFatalError());
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (IsCoarray(*symbol_)) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
if (allocateInfo_.gotTypeSpec) {
|
|
|
|
// C938
|
|
|
|
if (const DerivedTypeSpec *
|
|
|
|
derived{allocateInfo_.typeSpec->AsDerived()}) {
|
|
|
|
if (IsTeamType(derived)) {
|
|
|
|
context
|
|
|
|
.Say(allocateInfo_.typeSpecLoc.value(),
|
|
|
|
"Type-Spec in ALLOCATE must not be TEAM_TYPE from ISO_FORTRAN_ENV when an allocatable object is a coarray"_err_en_US)
|
2019-05-07 00:33:45 +08:00
|
|
|
.Attach(name_.source, "'%s' is a coarray"_en_US, name_.source);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
2019-06-22 08:32:11 +08:00
|
|
|
} else if (IsIsoCType(derived)) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context
|
|
|
|
.Say(allocateInfo_.typeSpecLoc.value(),
|
|
|
|
"Type-Spec in ALLOCATE must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray"_err_en_US)
|
2019-05-07 00:33:45 +08:00
|
|
|
.Attach(name_.source, "'%s' is a coarray"_en_US, name_.source);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
2019-11-20 11:10:02 +08:00
|
|
|
} else if (allocateInfo_.gotSource || allocateInfo_.gotMold) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
// C948
|
2019-05-14 00:33:18 +08:00
|
|
|
const evaluate::DynamicType &sourceType{
|
|
|
|
allocateInfo_.sourceExprType.value()};
|
2019-12-17 06:28:23 +08:00
|
|
|
if (const auto *derived{evaluate::GetDerivedTypeSpec(sourceType)}) {
|
|
|
|
if (IsTeamType(derived)) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context
|
|
|
|
.Say(allocateInfo_.sourceExprLoc.value(),
|
|
|
|
"SOURCE or MOLD expression type must not be TEAM_TYPE from ISO_FORTRAN_ENV when an allocatable object is a coarray"_err_en_US)
|
2019-05-07 00:33:45 +08:00
|
|
|
.Attach(name_.source, "'%s' is a coarray"_en_US, name_.source);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
2019-12-17 06:28:23 +08:00
|
|
|
} else if (IsIsoCType(derived)) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
context
|
|
|
|
.Say(allocateInfo_.sourceExprLoc.value(),
|
|
|
|
"SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray"_err_en_US)
|
2019-05-07 00:33:45 +08:00
|
|
|
.Attach(name_.source, "'%s' is a coarray"_en_US, name_.source);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (!hasAllocateCoarraySpec()) {
|
|
|
|
// C941
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Coarray specification must appear in ALLOCATE when allocatable object is a coarray"_err_en_US);
|
|
|
|
return false;
|
|
|
|
} else {
|
|
|
|
if (allocateCoarraySpecRank_ != corank_) {
|
|
|
|
// Second and last part of C942
|
|
|
|
context
|
|
|
|
.Say(name_.source,
|
|
|
|
"Corank of coarray specification in ALLOCATE must match corank of alloctable coarray"_err_en_US)
|
2019-06-05 08:03:34 +08:00
|
|
|
.Attach(
|
|
|
|
symbol_->name(), "Declared here with corank %d"_en_US, corank_);
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
} else { // Not a coarray
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
if (hasAllocateCoarraySpec()) {
|
|
|
|
// C941
|
|
|
|
context.Say(name_.source,
|
|
|
|
"Coarray specification must not appear in ALLOCATE when allocatable object is not a coarray"_err_en_US);
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (const parser::CoindexedNamedObject *
|
|
|
|
coindexedObject{parser::GetCoindexedNamedObject(allocateObject_)}) {
|
|
|
|
// C950
|
|
|
|
context.Say(parser::FindSourceLocation(*coindexedObject),
|
|
|
|
"Allocatable object must not be coindexed in ALLOCATE"_err_en_US);
|
|
|
|
return false;
|
2019-04-23 20:57:50 +08:00
|
|
|
}
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
void AllocateChecker::Leave(const parser::AllocateStmt &allocateStmt) {
|
|
|
|
if (auto info{CheckAllocateOptions(allocateStmt, context_)}) {
|
|
|
|
for (const parser::Allocation &allocation :
|
|
|
|
std::get<std::list<parser::Allocation>>(allocateStmt.t)) {
|
[flang] Allocate semantic checks (second part)
Implement semantic checks and realted tests for constraints:
C937, C938, C939, C940, C941, C942, C945 (second part),
C946, C947, C948, C949 and C950.
Original-commit: flang-compiler/f18@b4965d272b1749d554e3d1388c0a7856591741e8
Tree-same-pre-rewrite: false
2019-04-26 16:10:04 +08:00
|
|
|
AllocationCheckerHelper{allocation, *info}.RunChecks(context_);
|
2019-04-23 20:57:50 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
} // namespace Fortran::semantics
|