Magic-Mirror/llvm-capstone
1
0
Fork 0
mirror of https://github.com/capstone-engine/llvm-capstone.git synced 2025-03-01 14:58:18 +00:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

[flang] Support SELECT RANK on allocatables & pointers

Browse Source 
Unlike other executable constructs with associating selectors, the
selector of a SELECT RANK construct can have the ALLOCATABLE or POINTER
attribute, and will work as an allocatable or object pointer within
each rank case, so long as there is no RANK(*) case.

Getting this right exposed a correctness risk with the popular
predicate IsAllocatableOrPointer() -- it will be true for procedure
pointers as well as object pointers, and in many contexts, a procedure
pointer should not be acceptable.  So this patch adds the new predicate
IsAllocatableOrObjectPointer(), and updates some call sites of the original
function to use the new one.

Differential Revision: https://reviews.llvm.org/D159043
This commit is contained in:
Peter Klausler 2023-08-21 12:21:49 -07:00
parent d77ae428e0
commit 031b4e5e79
No known key found for this signature in database
21 changed files with 222 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
flang/include/flang/Evaluate/tools.h
View File

@ -1189,7 +1189,10 @@ bool IsFunction(const Symbol &);
bool IsFunction(const Scope &);
bool IsProcedure(const Symbol &);
bool IsProcedure(const Scope &);
bool IsProcedurePointer(const Symbol *);
bool IsProcedurePointer(const Symbol &);
bool IsObjectPointer(const Symbol *);
bool IsAllocatableOrObjectPointer(const Symbol *);
bool IsAutomatic(const Symbol &);
bool IsSaved(const Symbol &); // saved implicitly or explicitly
bool IsDummy(const Symbol &);

5
flang/include/flang/Semantics/symbol.h
View File

@ -237,7 +237,8 @@ private:
llvm::raw_ostream &, const EntityDetails &);
};
// Symbol is associated with a name or expression in a SELECT TYPE or ASSOCIATE.
// Symbol is associated with a name or expression in an ASSOCIATE,
// SELECT TYPE, or SELECT RANK construct.
class AssocEntityDetails : public EntityDetails {
public:
AssocEntityDetails() {}
@ -252,7 +253,7 @@ public:
private:
MaybeExpr expr_;
std::optional<int> rank_;
std::optional<int> rank_; // for SELECT RANK
};
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const AssocEntityDetails &);

1
flang/include/flang/Semantics/tools.h
View File

@ -143,6 +143,7 @@ inline bool IsPointer(const Symbol &symbol) {
inline bool IsAllocatable(const Symbol &symbol) {
return symbol.attrs().test(Attr::ALLOCATABLE);
}
// IsAllocatableOrObjectPointer() may be the better choice
inline bool IsAllocatableOrPointer(const Symbol &symbol) {
return IsPointer(symbol) || IsAllocatable(symbol);
}

2
flang/lib/Evaluate/intrinsics.cpp
View File

@ -2221,7 +2221,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
if (dummy[*dimArg].optionality == Optionality::required) {
if (const Symbol *whole{
UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) {
if (IsOptional(*whole) || IsAllocatableOrPointer(*whole)) {
if (IsOptional(*whole) || IsAllocatableOrObjectPointer(whole)) {
if (rank == Rank::scalarIfDim || arrayRank.value_or(-1) == 1) {
messages.Say(
"The actual argument for DIM= is optional, pointer, or allocatable, and it is assumed to be present and equal to 1 at execution time"_port_en_US);

39
flang/lib/Evaluate/tools.cpp
View File

@ -1158,7 +1158,8 @@ std::optional<Expr<SomeType>> DataConstantConversionExtension(
bool IsAllocatableOrPointerObject(
const Expr<SomeType> &expr, FoldingContext &context) {
const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
return (sym && semantics::IsAllocatableOrPointer(sym->GetUltimate())) ||
return (sym &&
semantics::IsAllocatableOrObjectPointer(&sym->GetUltimate())) ||
evaluate::IsObjectPointer(expr, context);
}
@ -1388,17 +1389,39 @@ bool IsProcedure(const Scope &scope) {
return symbol && IsProcedure(*symbol);
}
bool IsProcedurePointer(const Symbol &original) {
const Symbol &symbol{GetAssociationRoot(original)};
return IsPointer(symbol) && IsProcedure(symbol);
}
bool IsProcedurePointer(const Symbol *symbol) {
return symbol && IsProcedurePointer(*symbol);
}
bool IsObjectPointer(const Symbol *original) {
if (original) {
const Symbol &symbol{GetAssociationRoot(*original)};
return IsPointer(symbol) && !IsProcedure(symbol);
} else {
return false;
}
}
bool IsAllocatableOrObjectPointer(const Symbol *original) {
if (original) {
const Symbol &symbol{GetAssociationRoot(*original)};
return IsAllocatable(symbol) || (IsPointer(symbol) && !IsProcedure(symbol));
} else {
return false;
}
}
const Symbol *FindCommonBlockContaining(const Symbol &original) {
const Symbol &root{GetAssociationRoot(original)};
const auto *details{root.detailsIf<ObjectEntityDetails>()};
return details ? details->commonBlock() : nullptr;
}
bool IsProcedurePointer(const Symbol &original) {
const Symbol &symbol{GetAssociationRoot(original)};
return IsPointer(symbol) && IsProcedure(symbol);
}
// 3.11 automatic data object
bool IsAutomatic(const Symbol &original) {
const Symbol &symbol{original.GetUltimate()};
@ -1516,14 +1539,14 @@ bool IsAssumedShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
return object && object->CanBeAssumedShape() &&
!semantics::IsAllocatableOrPointer(ultimate);
!semantics::IsAllocatableOrObjectPointer(&ultimate);
}
bool IsDeferredShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
return object && object->CanBeDeferredShape() &&
semantics::IsAllocatableOrPointer(ultimate);
semantics::IsAllocatableOrObjectPointer(&ultimate);
}
bool IsFunctionResult(const Symbol &original) {

2
flang/lib/Lower/Bridge.cpp
View File

@ -581,7 +581,7 @@ public:
llvm::ArrayRef<mlir::Value> typeParams) -> mlir::Value {
mlir::Value allocVal = builder->allocateLocal(
loc,
Fortran::semantics::IsAllocatableOrPointer(hsym.GetUltimate())
Fortran::semantics::IsAllocatableOrObjectPointer(&hsym.GetUltimate())
? hSymType
: symType,
mangleName(sym), toStringRef(sym.GetUltimate().name()),

8
flang/lib/Lower/ConvertExprToHLFIR.cpp
View File

@ -129,7 +129,7 @@ public:
// shape is deferred and should not be loaded now to preserve
// pointer/allocatable aspects.
if (componentSym.Rank() == 0 ||
Fortran::semantics::IsAllocatableOrPointer(componentSym))
Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym))
return mlir::Value{};
fir::FirOpBuilder &builder = getBuilder();
@ -488,8 +488,8 @@ private:
// array ref designates the target (this is done in "visit"). Other
// components need special care to deal with the array%array_comp(indices)
// case.
if (Fortran::semantics::IsAllocatableOrPointer(
component->GetLastSymbol()))
if (Fortran::semantics::IsAllocatableOrObjectPointer(
&component->GetLastSymbol()))
baseType = visit(*component, partInfo);
else
baseType = hlfir::getFortranElementOrSequenceType(
@ -734,7 +734,7 @@ private:
if (charTy.hasConstantLen())
partInfo.typeParams.push_back(
builder.createIntegerConstant(loc, idxTy, charTy.getLen()));
else if (!Fortran::semantics::IsAllocatableOrPointer(componentSym))
else if (!Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym))
TODO(loc, "compute character length of automatic character component "
"in a PDT");
// Otherwise, the length of the component is deferred and will only

2
flang/lib/Lower/IO.cpp
View File

@ -498,7 +498,7 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
// A global pointer or allocatable variable has a descriptor for typical
// accesses. Variables in multiple namelist groups may already have one.
// Create descriptors for other cases.
if (!IsAllocatableOrPointer(s)) {
if (!IsAllocatableOrObjectPointer(&s)) {
std::string mangleName =
Fortran::lower::mangle::globalNamelistDescriptorName(s);
if (builder.getNamedGlobal(mangleName))

2
flang/lib/Lower/Mangler.cpp
View File

@ -277,5 +277,5 @@ std::string Fortran::lower::mangle::mangleArrayLiteral(
std::string Fortran::lower::mangle::globalNamelistDescriptorName(
const Fortran::semantics::Symbol &sym) {
std::string name = mangleName(sym);
return IsAllocatableOrPointer(sym) ? name : name + ".desc"s;
return IsAllocatableOrObjectPointer(&sym) ? name : name + ".desc"s;
}

5
flang/lib/Lower/OpenMP.cpp
View File

@ -1553,7 +1553,8 @@ bool ClauseProcessor::processCopyin() const {
checkAndCopyHostAssociateVar(&*mem, &insPt);
break;
}
if (Fortran::semantics::IsAllocatableOrPointer(sym->GetUltimate()))
if (Fortran::semantics::IsAllocatableOrObjectPointer(
&sym->GetUltimate()))
TODO(converter.getCurrentLocation(),
"pointer or allocatable variables in Copyin clause");
assert(sym->has<Fortran::semantics::HostAssocDetails>() &&
@ -1815,7 +1816,7 @@ static fir::GlobalOp globalInitialization(
firOpBuilder.createGlobal(currentLocation, ty, globalName, linkage);
// Create default initialization for non-character scalar.
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
if (Fortran::semantics::IsAllocatableOrObjectPointer(&sym)) {
mlir::Type baseAddrType = ty.dyn_cast<fir::BoxType>().getEleTy();
Fortran::lower::createGlobalInitialization(
firOpBuilder, global, [&](fir::FirOpBuilder &b) {

23
flang/lib/Semantics/check-allocate.cpp
View File

@ -39,14 +39,14 @@ class AllocationCheckerHelper {
public:
AllocationCheckerHelper(
const parser::Allocation &alloc, AllocateCheckerInfo &info)
: allocateInfo_{info}, allocateObject_{std::get<parser::AllocateObject>(
alloc.t)},
: allocateInfo_{info},
allocateObject_{std::get<parser::AllocateObject>(alloc.t)},
name_{parser::GetLastName(allocateObject_)},
symbol_{name_.symbol ? &name_.symbol->GetUltimate() : nullptr},
original_{name_.symbol ? &name_.symbol->GetUltimate() : nullptr},
symbol_{original_ ? &ResolveAssociations(*original_) : nullptr},
type_{symbol_ ? symbol_->GetType() : nullptr},
allocateShapeSpecRank_{ShapeSpecRank(alloc)}, rank_{symbol_
? symbol_->Rank()
: 0},
allocateShapeSpecRank_{ShapeSpecRank(alloc)},
rank_{original_ ? original_->Rank() : 0},
allocateCoarraySpecRank_{CoarraySpecRank(alloc)},
corank_{symbol_ ? symbol_->Corank() : 0} {}
@ -91,7 +91,8 @@ private:
AllocateCheckerInfo &allocateInfo_;
const parser::AllocateObject &allocateObject_;
const parser::Name &name_;
const Symbol *symbol_{nullptr};
const Symbol *original_{nullptr}; // no USE or host association
const Symbol *symbol_{nullptr}; // no USE, host, or construct association
const DeclTypeSpec *type_{nullptr};
const int allocateShapeSpecRank_;
const int rank_{0};
@ -558,17 +559,17 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
}
} else {
// first part of C942
// explicit shape-spec-list
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)
.Attach(symbol_->name(), "Declared here with rank %d"_en_US, rank_);
.Attach(
original_->name(), "Declared here with rank %d"_en_US, rank_);
return false;
}
}
} else {
// C940
} else { // allocating a scalar object
if (hasAllocateShapeSpecList()) {
context.Say(name_.source,
"Shape specifications must not appear when allocatable object is scalar"_err_en_US);

2
flang/lib/Semantics/check-call.cpp
View File

@ -1430,7 +1430,7 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
whole->name());
} else if (context.ShouldWarn(
common::UsageWarning::TransferSizePresence) &&
IsAllocatableOrPointer(*whole)) {
IsAllocatableOrObjectPointer(whole)) {
messages.Say(
"SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
}

58
flang/lib/Semantics/check-deallocate.cpp
View File

@ -19,20 +19,18 @@ namespace Fortran::semantics {
void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
for (const parser::AllocateObject &allocateObject :
std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)) {
parser::CharBlock source;
const Symbol *symbol{nullptr};
common::visit(
common::visitors{
[&](const parser::Name &name) {
source = name.source;
symbol = name.symbol;
const Symbol *symbol{
name.symbol ? &name.symbol->GetUltimate() : nullptr};
;
if (context_.HasError(symbol)) {
// already reported an error
} else if (!IsVariableName(*symbol)) {
context_.Say(name.source,
"Name in DEALLOCATE statement must be a variable name"_err_en_US);
} else if (!IsAllocatableOrPointer(
symbol->GetUltimate())) { // C932
} else if (!IsAllocatableOrObjectPointer(symbol)) { // C936
context_.Say(name.source,
"Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
} else if (auto whyNot{WhyNotDefinable(name.source,
@ -61,30 +59,32 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
[&](const parser::StructureComponent &structureComponent) {
// Only perform structureComponent checks if it was successfully
// analyzed by expression analysis.
source = structureComponent.component.source;
symbol = structureComponent.component.symbol;
auto source{structureComponent.component.source};
if (const auto *expr{GetExpr(context_, allocateObject)}) {
if (symbol) {
if (!IsAllocatableOrPointer(*symbol)) { // C932
context_.Say(source,
"Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
} else if (auto whyNot{WhyNotDefinable(source,
context_.FindScope(source),
{DefinabilityFlag::PointerDefinition,
DefinabilityFlag::AcceptAllocatable},
*expr)}) {
context_
.Say(source,
"Name in DEALLOCATE statement is not definable"_err_en_US)
.Attach(std::move(*whyNot));
} else if (auto whyNot{WhyNotDefinable(source,
context_.FindScope(source),
DefinabilityFlags{}, *expr)}) {
context_
.Say(source,
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
.Attach(std::move(*whyNot));
}
if (const Symbol *
symbol{structureComponent.component.symbol
? &structureComponent.component.symbol
->GetUltimate()
: nullptr};
!IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
context_.Say(source,
"Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
} else if (auto whyNot{WhyNotDefinable(source,
context_.FindScope(source),
{DefinabilityFlag::PointerDefinition,
DefinabilityFlag::AcceptAllocatable},
*expr)}) {
context_
.Say(source,
"Name in DEALLOCATE statement is not definable"_err_en_US)
.Attach(std::move(*whyNot));
} else if (auto whyNot{WhyNotDefinable(source,
context_.FindScope(source), DefinabilityFlags{},
*expr)}) {
context_
.Say(source,
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
.Attach(std::move(*whyNot));
}
}
},

2
flang/lib/Semantics/check-declarations.cpp
View File

@ -731,7 +731,7 @@ void CheckHelper::CheckObjectEntity(
"!DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure"_err_en_US);
}
if (IsPassedViaDescriptor(symbol)) {
if (IsAllocatableOrPointer(symbol)) {
if (IsAllocatableOrObjectPointer(&symbol)) {
if (inExplicitInterface) {
WarnIfNotInModuleFile(
"!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US);

4
flang/lib/Semantics/check-omp-structure.cpp
View File

@ -203,8 +203,8 @@ void OmpStructureChecker::CheckMultListItems() {
"ALIGNED clause"_err_en_US,
name->ToString());
} else if (!(IsBuiltinCPtr(*(name->symbol)) ||
IsAllocatableOrPointer(
(name->symbol->GetUltimate())))) {
IsAllocatableOrObjectPointer(
&name->symbol->GetUltimate()))) {
context_.Say(itr->second->source,
"'%s' in ALIGNED clause must be of type C_PTR, POINTER or "
"ALLOCATABLE"_err_en_US,

2
flang/lib/Semantics/check-select-rank.cpp
View File

@ -86,7 +86,7 @@ void SelectRankConstructChecker::Leave(
.Attach(prevLocStar, "Previous use"_en_US);
}
if (saveSelSymbol &&
IsAllocatableOrPointer(*saveSelSymbol)) { // C1155
IsAllocatableOrPointer(*saveSelSymbol)) { // F'2023 C1160
context_.Say(parser::FindSourceLocation(selectRankStmtSel),
"RANK (*) cannot be used when selector is "
"POINTER or ALLOCATABLE"_err_en_US);

2
flang/lib/Semantics/definable.cpp
View File

@ -169,7 +169,7 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
const Symbol &ultimate{original.GetUltimate()};
if (flags.test(DefinabilityFlag::PointerDefinition)) {
if (flags.test(DefinabilityFlag::AcceptAllocatable)) {
if (!IsAllocatableOrPointer(ultimate)) {
if (!IsAllocatableOrObjectPointer(&ultimate)) {
return BlameSymbol(
at, "'%s' is neither a pointer nor an allocatable"_en_US, original);
}

2
flang/lib/Semantics/resolve-directives.cpp
View File

@ -1113,7 +1113,7 @@ void AccAttributeVisitor::EnsureAllocatableOrPointer(
common::visitors{
[&](const parser::Designator &designator) {
const auto &lastName{GetLastName(designator)};
if (!IsAllocatableOrPointer(*lastName.symbol)) {
if (!IsAllocatableOrObjectPointer(lastName.symbol)) {
context_.Say(designator.source,
"Argument `%s` on the %s clause must be a variable or "
"array with the POINTER or ALLOCATABLE attribute"_err_en_US,

7
flang/lib/Semantics/resolve-names.cpp
View File

@ -6942,7 +6942,11 @@ void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {
if (auto *symbol{MakeAssocEntity()}) {
SetTypeFromAssociation(*symbol);
SetAttrsFromAssociation(*symbol);
// Don't call SetAttrsFromAssociation() for SELECT RANK.
symbol->attrs() |=
evaluate::GetAttrs(GetCurrentAssociation().selector.expr) &
Attrs{Attr::ALLOCATABLE, Attr::ASYNCHRONOUS, Attr::POINTER,
Attr::TARGET, Attr::VOLATILE};
if (const auto *init{std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {
if (auto val{EvaluateInt64(context(), *init)}) {
auto &details{symbol->get<AssocEntityDetails>()};
@ -7039,6 +7043,7 @@ void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) {
}
// If current selector is a variable, set some of its attributes on symbol.
// For ASSOCIATE, CHANGE TEAM, and SELECT TYPE only; not SELECT RANK.
void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {
Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
symbol.attrs() |=

8
flang/lib/Semantics/tools.cpp
View File

@ -1208,13 +1208,13 @@ ComponentIterator<componentKind>::const_iterator::PlanComponentTraversal(
// Order Component (only visit parents)
traverse = component.test(Symbol::Flag::ParentComp);
} else if constexpr (componentKind == ComponentKind::Direct) {
traverse = !IsAllocatableOrPointer(component);
traverse = !IsAllocatableOrObjectPointer(&component);
} else if constexpr (componentKind == ComponentKind::Ultimate) {
traverse = !IsAllocatableOrPointer(component);
traverse = !IsAllocatableOrObjectPointer(&component);
} else if constexpr (componentKind == ComponentKind::Potential) {
traverse = !IsPointer(component);
} else if constexpr (componentKind == ComponentKind::Scope) {
traverse = !IsAllocatableOrPointer(component);
traverse = !IsAllocatableOrObjectPointer(&component);
} else if constexpr (componentKind ==
ComponentKind::PotentialAndPointer) {
traverse = !IsPointer(component);
@ -1248,7 +1248,7 @@ static bool StopAtComponentPre(const Symbol &component) {
return true;
} else if constexpr (componentKind == ComponentKind::Ultimate) {
return component.has<ProcEntityDetails>() ||
IsAllocatableOrPointer(component) ||
IsAllocatableOrObjectPointer(&component) ||
(component.get<ObjectEntityDetails>().type() &&
component.get<ObjectEntityDetails>().type()->AsIntrinsic());
} else if constexpr (componentKind == ComponentKind::Potential) {

115
flang/test/Semantics/select-rank03.f90 Normal file
View File

@ -0,0 +1,115 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
program test
real, allocatable :: a0, a1(:)
real, pointer :: p0, p1(:)
real, target :: t0, t1(1)
contains
subroutine allocatables(a)
real, allocatable :: a(..)
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
select rank(a)
rank (0)
allocate(a) ! ok
deallocate(a) ! ok
allocate(a, source=a0) ! ok
allocate(a, mold=p0) ! ok
a = 1. ! ok
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
a = [1.]
!ERROR: If SOURCE appears, the related expression must be scalar or have the same rank as each allocatable object in ALLOCATE
allocate(a, source=a1)
allocate(a, mold=p1) ! ok, mold= ignored
rank (1)
allocate(a(1)) ! ok
deallocate(a) ! ok
a = 1. ! ok
a = [1.] ! ok
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a, source=a0)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a, mold=p0)
allocate(a, source=a1) ! ok
allocate(a, mold=p1) ! ok
rank (2)
allocate(a(1,1)) ! ok
deallocate(a) ! ok
a = 1. ! ok
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches rank 2 array of REAL(4) and rank 1 array of REAL(4)
a = [1.]
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a, source=a0)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a, mold=p0)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a, source=a1)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a, mold=p1)
rank (*)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a)
deallocate(a)
a = 1.
rank default
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(a)
deallocate(a)
a = 1.
end select
end
subroutine pointers(p)
real, pointer :: p(..)
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
select rank(p)
rank (0)
allocate(p) ! ok
deallocate(p) ! ok
allocate(p, source=a0) ! ok
allocate(p, mold=p0) ! ok
!ERROR: If SOURCE appears, the related expression must be scalar or have the same rank as each allocatable object in ALLOCATE
allocate(p, source=a1)
allocate(p, mold=p1) ! ok, mold ignored
p => t0 ! ok
!ERROR: Pointer has rank 0 but target has rank 1
p => t1
rank (1)
allocate(p(1)) ! ok
deallocate(p) ! ok
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p, source=a0)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p, mold=p0)
allocate(p, source=a1) ! ok
allocate(p, mold=p1) ! ok
!ERROR: Pointer has rank 1 but target has rank 0
p => t0
p => t1 ! ok
rank (2)
allocate(p(1,1)) ! ok
deallocate(p) ! ok
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p, source=a0)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p, mold=p0)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p, source=a1)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p, mold=p1)
!ERROR: Pointer has rank 2 but target has rank 0
p => t0
!ERROR: Pointer has rank 2 but target has rank 1
p => t1
rank (*)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p)
deallocate(p)
rank default
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
allocate(p)
deallocate(p)
!ERROR: pointer 'p' associated with object 't0' with incompatible type or shape
p => t0
!ERROR: pointer 'p' associated with object 't1' with incompatible type or shape
p => t1
end select
end
end