mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-25 07:36:06 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Correct semantic representation & handling of RANK(*) (#66234)

Browse Source 
A RANK(*) case in a SELECT RANK construct selects the case of an
assumed-rank dummy argument whose effective actual argument is an
assumed-size array. In this case, the attributes of the selector are
those of a rank-1 assumed-size array, and the selector cannot be
allocatable or a pointer.

Ensure that the representation of a SELECT RANK construct's per-case
AssocEntityDetails can distinguish RANK(n), RANK(*), and RANK DEFAULT,
and clean up various code sites and tests where the distinctions matter.
This commit is contained in:
Peter Klausler 2023-09-13 16:13:31 -07:00 committed by GitHub
parent 9a220dc6ab
commit 4fed595997
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 160 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1224,10 +1224,11 @@ bool IsEventTypeOrLockType(const DerivedTypeSpec *);
// of the construct entity.
// (E.g., for ASSOCIATE(x => y%z), ResolveAssociations(x) returns x,
// while GetAssociationRoot(x) returns y.)
// ResolveAssociationsExceptSelectRank() stops at a RANK case symbol.
// In a SELECT RANK construct, ResolveAssociations() stops at a
// RANK(n) or RANK(*) case symbol, but traverses the selector for
// RANK DEFAULT.
const Symbol &ResolveAssociations(const Symbol &);
const Symbol &GetAssociationRoot(const Symbol &);
const Symbol &ResolveAssociationsExceptSelectRank(const Symbol &);
const Symbol *FindCommonBlockContaining(const Symbol &);
int CountLenParameters(const DerivedTypeSpec &);

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

@ -278,12 +278,33 @@ public:
AssocEntityDetails &operator=(const AssocEntityDetails &) = default;
AssocEntityDetails &operator=(AssocEntityDetails &&) = default;
const MaybeExpr &expr() const { return expr_; }
// SELECT RANK's rank cases will return a populated result for
// RANK(n) and RANK(*), and IsAssumedRank() will be true for
// RANK DEFAULT.
std::optional<int> rank() const {
int r{rank_.value_or(0)};
if (r == isAssumedSize) {
return 1; // RANK(*)
} else if (r == isAssumedRank) {
return std::nullopt; // RANK DEFAULT
} else {
return rank_;
}
}
bool IsAssumedSize() const { return rank_.value_or(0) == isAssumedSize; }
bool IsAssumedRank() const { return rank_.value_or(0) == isAssumedRank; }
void set_rank(int rank);
std::optional<int> rank() const { return rank_; }
void set_IsAssumedSize();
void set_IsAssumedRank();
private:
MaybeExpr expr_;
std::optional<int> rank_; // for SELECT RANK
// Populated for SELECT RANK with rank (n>=0) for RANK(n),
// isAssumedSize for RANK(*), or isAssumedRank for RANK DEFAULT.
static constexpr int isAssumedSize{-1}; // RANK(*)
static constexpr int isAssumedRank{-2}; // RANK DEFAULT
std::optional<int> rank_;
};
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const AssocEntityDetails &);
@ -862,12 +883,14 @@ private:
return iface ? iface->RankImpl(depth) : 0;
},
[](const AssocEntityDetails &aed) {
if (const auto &expr{aed.expr()}) {
if (auto assocRank{aed.rank()}) {
return *assocRank;
} else {
return expr->Rank();
}
if (auto assocRank{aed.rank()}) {
// RANK(n) & RANK(*)
return *assocRank;
} else if (aed.IsAssumedRank()) {
// RANK DEFAULT
return 0;
} else if (const auto &expr{aed.expr()}) {
return expr->Rank();
} else {
return 0;
}

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

@ -179,8 +179,13 @@ const Symbol *IsFinalizable(const DerivedTypeSpec &,
const Symbol *HasImpureFinal(const Symbol &);
bool IsInBlankCommon(const Symbol &);
inline bool IsAssumedSizeArray(const Symbol &symbol) {
const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
return details && details->IsAssumedSize();
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
return object->IsAssumedSize();
} else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
return assoc->IsAssumedSize();
} else {
return false;
}
}
bool IsAssumedLengthCharacter(const Symbol &);
bool IsExternal(const Symbol &);

35
flang/lib/Evaluate/shape.cpp
View File

@ -248,17 +248,17 @@ public:
Result GetLowerBound(const Symbol &symbol0, NamedEntity &&base) const {
const Symbol &symbol{symbol0.GetUltimate()};
if (const auto *details{
if (const auto *object{
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
int rank{details->shape().Rank()};
int rank{object->shape().Rank()};
if (dimension_ < rank) {
const semantics::ShapeSpec &shapeSpec{details->shape()[dimension_]};
const semantics::ShapeSpec &shapeSpec{object->shape()[dimension_]};
if (shapeSpec.lbound().isExplicit()) {
if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) {
if constexpr (LBOUND_SEMANTICS) {
bool ok{false};
auto lbValue{ToInt64(*lbound)};
if (dimension_ == rank - 1 && details->IsAssumedSize()) {
if (dimension_ == rank - 1 && object->IsAssumedSize()) {
// last dimension of assumed-size dummy array: don't worry
// about handling an empty dimension
ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound);
@ -309,7 +309,10 @@ public:
}
} else if (const auto *assoc{
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
if (assoc->rank()) { // SELECT RANK case
if (assoc->IsAssumedSize()) { // RANK(*)
return Result{1};
} else if (assoc->IsAssumedRank()) { // RANK DEFAULT
} else if (assoc->rank()) { // RANK(n)
const Symbol &resolved{ResolveAssociations(symbol)};
if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) {
return ExtentExpr{DescriptorInquiry{std::move(base),
@ -497,9 +500,11 @@ MaybeExtentExpr GetExtent(
const NamedEntity &base, int dimension, bool invariantOnly) {
CHECK(dimension >= 0);
const Symbol &last{base.GetLastSymbol()};
const Symbol &symbol{ResolveAssociationsExceptSelectRank(last)};
const Symbol &symbol{ResolveAssociations(last)};
if (const auto *assoc{last.detailsIf<semantics::AssocEntityDetails>()}) {
if (assoc->rank()) { // SELECT RANK case
if (assoc->IsAssumedSize() || assoc->IsAssumedRank()) { // RANK(*)/DEFAULT
return std::nullopt;
} else if (assoc->rank()) { // RANK(n)
if (semantics::IsDescriptor(symbol) && dimension < *assoc->rank()) {
return ExtentExpr{DescriptorInquiry{
NamedEntity{base}, DescriptorInquiry::Field::Extent, dimension}};
@ -595,8 +600,7 @@ MaybeExtentExpr ComputeUpperBound(
MaybeExtentExpr GetRawUpperBound(
const NamedEntity &base, int dimension, bool invariantOnly) {
const Symbol &symbol{
ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
int rank{details->shape().Rank()};
if (dimension < rank) {
@ -612,7 +616,11 @@ MaybeExtentExpr GetRawUpperBound(
}
} else if (const auto *assoc{
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
if (auto extent{GetAssociatedExtent(base, *assoc, dimension)}) {
if (assoc->IsAssumedSize() || assoc->IsAssumedRank()) {
return std::nullopt;
} else if (assoc->rank() && dimension >= *assoc->rank()) {
return std::nullopt;
} else if (auto extent{GetAssociatedExtent(base, *assoc, dimension)}) {
return ComputeUpperBound(
GetRawLowerBound(base, dimension), std::move(extent));
}
@ -645,8 +653,7 @@ static MaybeExtentExpr GetExplicitUBOUND(FoldingContext *context,
static MaybeExtentExpr GetUBOUND(FoldingContext *context,
const NamedEntity &base, int dimension, bool invariantOnly) {
const Symbol &symbol{
ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
int rank{details->shape().Rank()};
if (dimension < rank) {
@ -662,7 +669,9 @@ static MaybeExtentExpr GetUBOUND(FoldingContext *context,
}
} else if (const auto *assoc{
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
if (assoc->rank()) { // SELECT RANK case
if (assoc->IsAssumedSize() || assoc->IsAssumedRank()) {
return std::nullopt;
} else if (assoc->rank()) { // RANK (n)
const Symbol &resolved{ResolveAssociations(symbol)};
if (IsDescriptor(resolved) && dimension < *assoc->rank()) {
ExtentExpr lb{DescriptorInquiry{NamedEntity{base},

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

@ -702,15 +702,14 @@ std::optional<Expr<SomeType>> ConvertToType(
bool IsAssumedRank(const Symbol &original) {
if (const auto *assoc{original.detailsIf<semantics::AssocEntityDetails>()}) {
if (assoc->rank()) {
return false; // in SELECT RANK case
return false; // in RANK(n) or RANK(*)
} else if (assoc->IsAssumedRank()) {
return true; // RANK DEFAULT
}
}
const Symbol &symbol{semantics::ResolveAssociations(original)};
if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
return details->IsAssumedRank();
} else {
return false;
}
const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
return object && object->IsAssumedRank();
}
bool IsAssumedRank(const ActualArgument &arg) {
@ -1209,17 +1208,7 @@ namespace Fortran::semantics {
const Symbol &ResolveAssociations(const Symbol &original) {
const Symbol &symbol{original.GetUltimate()};
if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {
return ResolveAssociations(*nested);
}
}
return symbol;
}
const Symbol &ResolveAssociationsExceptSelectRank(const Symbol &original) {
const Symbol &symbol{original.GetUltimate()};
if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
if (!details->rank()) {
if (!details->rank()) { // Not RANK(n) or RANK(*)
if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {
return ResolveAssociations(*nested);
}

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

@ -39,16 +39,11 @@ class AllocationCheckerHelper {
public:
AllocationCheckerHelper(
const parser::Allocation &alloc, AllocateCheckerInfo &info)
: allocateInfo_{info},
allocateObject_{std::get<parser::AllocateObject>(alloc.t)},
name_{parser::GetLastName(allocateObject_)},
original_{name_.symbol ? &name_.symbol->GetUltimate() : nullptr},
symbol_{original_ ? &ResolveAssociations(*original_) : nullptr},
type_{symbol_ ? symbol_->GetType() : nullptr},
allocateShapeSpecRank_{ShapeSpecRank(alloc)},
rank_{original_ ? original_->Rank() : 0},
allocateCoarraySpecRank_{CoarraySpecRank(alloc)},
corank_{symbol_ ? symbol_->Corank() : 0} {}
: allocateInfo_{info}, allocateObject_{std::get<parser::AllocateObject>(
alloc.t)},
allocateShapeSpecRank_{ShapeSpecRank(alloc)}, allocateCoarraySpecRank_{
CoarraySpecRank(
alloc)} {}
bool RunChecks(SemanticsContext &context);
@ -90,14 +85,17 @@ private:
AllocateCheckerInfo &allocateInfo_;
const parser::AllocateObject &allocateObject_;
const parser::Name &name_;
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};
const int allocateCoarraySpecRank_;
const int corank_{0};
const int allocateShapeSpecRank_{0};
const int allocateCoarraySpecRank_{0};
const parser::Name &name_{parser::GetLastName(allocateObject_)};
// no USE or host association
const Symbol *original_{
name_.symbol ? &name_.symbol->GetUltimate() : nullptr};
// no USE, host, or construct association
const Symbol *symbol_{original_ ? &ResolveAssociations(*original_) : nullptr};
const DeclTypeSpec *type_{symbol_ ? symbol_->GetType() : nullptr};
const int rank_{original_ ? original_->Rank() : 0};
const int corank_{symbol_ ? symbol_->Corank() : 0};
bool hasDeferredTypeParameter_{false};
bool isUnlimitedPolymorphic_{false};
bool isAbstract_{false};
@ -539,6 +537,11 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
}
// Shape related checks
if (symbol_ && evaluate::IsAssumedRank(*symbol_)) {
context.Say(name_.source,
"An assumed-rank object may not appear in an ALLOCATE statement"_err_en_US);
return false;
}
if (rank_ > 0) {
if (!hasAllocateShapeSpecList()) {
// C939

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

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

6
flang/lib/Semantics/expression.cpp
View File

@ -260,11 +260,11 @@ MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
symbolRank, symbol.name(), subscripts);
}
return std::nullopt;
} else if (const auto *object{
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
} else if (symbol.has<semantics::ObjectEntityDetails>() ||
symbol.has<semantics::AssocEntityDetails>()) {
// C928 & C1002
if (Triplet *last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
if (!last->upper() && object->IsAssumedSize()) {
if (!last->upper() && IsAssumedSizeArray(symbol)) {
Say("Assumed-size array '%s' must have explicit final "
"subscript upper bound value"_err_en_US,
symbol.name());

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

@ -6942,17 +6942,32 @@ void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {
if (auto *symbol{MakeAssocEntity()}) {
SetTypeFromAssociation(*symbol);
auto &details{symbol->get<AssocEntityDetails>()};
// 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>()};
details.set_rank(*val);
Attrs selectorAttrs{
evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
Attrs attrsToKeep{Attr::ASYNCHRONOUS, Attr::TARGET, Attr::VOLATILE};
if (const auto *rankValue{
std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {
// RANK(n)
if (auto expr{EvaluateIntExpr(*rankValue)}) {
if (auto val{evaluate::ToInt64(*expr)}) {
details.set_rank(*val);
attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
} else {
Say("RANK() expression must be constant"_err_en_US);
}
}
} else if (std::holds_alternative<parser::Star>(x.u)) {
// RANK(*): assumed-size
details.set_IsAssumedSize();
} else {
CHECK(std::holds_alternative<parser::Default>(x.u));
// RANK DEFAULT: assumed-rank
details.set_IsAssumedRank();
attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
}
symbol->attrs() |= selectorAttrs & attrsToKeep;
}
}

10
flang/lib/Semantics/symbol.cpp
View File

@ -153,6 +153,8 @@ void EntityDetails::set_type(const DeclTypeSpec &type) {
}
void AssocEntityDetails::set_rank(int rank) { rank_ = rank; }
void AssocEntityDetails::set_IsAssumedSize() { rank_ = isAssumedSize; }
void AssocEntityDetails::set_IsAssumedRank() { rank_ = isAssumedRank; }
void EntityDetails::ReplaceType(const DeclTypeSpec &type) { type_ = &type; }
ObjectEntityDetails::ObjectEntityDetails(EntityDetails &&d)
@ -438,8 +440,12 @@ llvm::raw_ostream &operator<<(
llvm::raw_ostream &operator<<(
llvm::raw_ostream &os, const AssocEntityDetails &x) {
os << *static_cast<const EntityDetails *>(&x);
if (auto assocRank{x.rank()}) {
os << " rank: " << *assocRank;
if (x.IsAssumedSize()) {
os << " RANK(*)";
} else if (x.IsAssumedRank()) {
os << " RANK DEFAULT";
} else if (auto assocRank{x.rank()}) {
os << " RANK(" << *assocRank << ')';
}
DumpExpr(os, "expr", x.expr());
return os;

21
flang/test/Semantics/misc-intrinsics.f90
View File

@ -42,6 +42,25 @@ program test_size
print *, lbound(assumedRank, dim=2)
!ERROR: DIM=2 dimension is out of range for rank-1 array
print *, ubound(assumedRank, dim=2)
rank(*)
!ERROR: A dim= argument is required for 'size' when the array is assumed-size
print *, size(assumedRank)
!ERROR: missing mandatory 'dim=' argument
print *, ubound(assumedRank)
!ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
print *, shape(assumedRank)
!ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
call random_number(assumedRank)
!ERROR: DIM=0 dimension must be positive
print *, lbound(assumedRank, 0)
!ERROR: DIM=0 dimension must be positive
print *, ubound(assumedRank, 0)
!ERROR: DIM=1 dimension is out of range for rank-1 assumed-size array
print *, ubound(assumedRank, 1)
!ERROR: DIM=2 dimension is out of range for rank-1 array
print *, lbound(assumedRank, dim=2)
!ERROR: DIM=2 dimension is out of range for rank-1 array
print *, ubound(assumedRank, dim=2)
end select
! But these cases are fine:
print *, size(arg, dim=1)
@ -60,6 +79,8 @@ program test_size
rank(3)
print *, lbound(assumedRank, dim=2)
print *, ubound(assumedRank, dim=2)
rank(*)
print *, lbound(assumedRank, dim=1)
rank default
print *, lbound(assumedRank, dim=2)
print *, ubound(assumedRank, dim=2)

8
flang/test/Semantics/select-rank.f90
View File

@ -109,7 +109,8 @@ contains
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 3))
!ERROR: The value of the selector must be between zero and 15
RANK(-1)
print *, "rank: -ve"
print *, "rank: negative"
!ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == -1))
END SELECT
end subroutine
@ -119,8 +120,8 @@ contains
integer :: i,j
integer, dimension(..), pointer :: arg
integer, pointer :: arg2
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
select RANK(arg)
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
RANK (*)
print *, arg(1:1)
RANK (1)
@ -146,13 +147,10 @@ contains
print *, "Now it's rank 2 "
RANK (*)
print *, "Going for another rank"
!ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
!ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'
RANK (*)
print *, "This is Wrong"
!ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
END SELECT
end subroutine

17
flang/test/Semantics/select-rank03.f90
View File

@ -6,7 +6,6 @@ program test
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
@ -44,13 +43,17 @@ program test
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)
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
rank (*)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
!ERROR: Whole assumed-size array 'a' may not appear here without subscripts
!ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
allocate(a)
!ERROR: Whole assumed-size array 'a' may not appear here without subscripts
deallocate(a)
!ERROR: Whole assumed-size array 'a' may not appear here without subscripts
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
!ERROR: An assumed-rank object may not appear in an ALLOCATE statement
allocate(a)
deallocate(a)
a = 1.
@ -58,7 +61,6 @@ program test
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
@ -98,12 +100,15 @@ program test
p => t0
!ERROR: Pointer has rank 2 but target has rank 1
p => t1
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
rank (*)
!ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
!ERROR: Whole assumed-size array 'p' may not appear here without subscripts
!ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
allocate(p)
!ERROR: Whole assumed-size array 'p' may not appear here without subscripts
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
!ERROR: An assumed-rank object may not appear in an ALLOCATE statement
allocate(p)
deallocate(p)
!ERROR: pointer 'p' associated with object 't0' with incompatible type or shape