[flang] Fix off-by-one error in preprocessing expressions

Original-commit: flang-compiler/f18@4c08a4a1be
Reviewed-on: https://github.com/flang-compiler/f18/pull/891
This commit is contained in:
peter klausler 2019-12-20 13:03:30 -08:00
parent f8393113f2
commit 16c5b86368
10 changed files with 225 additions and 98 deletions

View File

@ -204,7 +204,7 @@ template<typename A> class FunctionRef : public ProcedureRef {
public:
using Result = A;
CLASS_BOILERPLATE(FunctionRef)
FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
: ProcedureRef{std::move(p), std::move(a)} {}

View File

@ -981,8 +981,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context.messages().Say(
"%s(real(kind=%d)) cannot be folded on host"_en_US, name, KIND);
}
}
if (name == "atan" || name == "atan2" || name == "hypot" || name == "mod") {
} else if (name == "atan" || name == "atan2" || name == "hypot" ||
name == "mod") {
std::string localName{name == "atan2" ? "atan" : name};
CHECK(args.size() == 2);
if (auto callable{

View File

@ -9,6 +9,7 @@
#include "shape.h"
#include "characteristics.h"
#include "fold.h"
#include "intrinsics.h"
#include "tools.h"
#include "type.h"
#include "../common/idioms.h"
@ -503,6 +504,41 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
return AsShape(context_, ConvertToType<ExtentType>(std::move(shape)));
}
}
} else if (intrinsic->name == "pack") {
if (call.arguments().size() >= 3 && call.arguments().at(2)) {
// SHAPE(PACK(,,VECTOR=v)) -> SHAPE(v)
return (*this)(call.arguments().at(2));
} else if (call.arguments().size() >= 2) {
if (auto maskShape{(*this)(call.arguments().at(1))}) {
if (maskShape->size() == 0) {
// Scalar MASK= -> [MERGE(SIZE(ARRAY=), 0, mask)]
if (auto arrayShape{(*this)(call.arguments().at(0))}) {
auto arraySize{GetSize(std::move(*arrayShape))};
CHECK(arraySize);
ActualArguments toMerge{
ActualArgument{AsGenericExpr(std::move(*arraySize))},
ActualArgument{AsGenericExpr(ExtentExpr{0})},
common::Clone(call.arguments().at(1))};
auto specific{context_.intrinsics().Probe(
CallCharacteristics{"merge"}, toMerge, context_)};
CHECK(specific);
return Shape{ExtentExpr{FunctionRef<ExtentType>{
ProcedureDesignator{std::move(specific->specificIntrinsic)},
std::move(specific->arguments)}}};
}
} else {
// Non-scalar MASK= -> [COUNT(mask)]
ActualArguments toCount{ActualArgument{common::Clone(
DEREF(call.arguments().at(1).value().UnwrapExpr()))}};
auto specific{context_.intrinsics().Probe(
CallCharacteristics{"count"}, toCount, context_)};
CHECK(specific);
return Shape{ExtentExpr{FunctionRef<ExtentType>{
ProcedureDesignator{std::move(specific->specificIntrinsic)},
std::move(specific->arguments)}}};
}
}
}
} else if (intrinsic->name == "spread") {
// SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
// at position DIM.

View File

@ -235,6 +235,19 @@ std::optional<DataRef> ExtractDataRef(const std::optional<A> &x) {
}
}
// Predicate: is an expression is an array element reference?
template<typename T> bool IsArrayElement(const Expr<T> &expr) {
if (auto dataRef{ExtractDataRef(expr)}) {
const DataRef *ref{&*dataRef};
while (const Component * component{std::get_if<Component>(&ref->u)}) {
ref = &component->base();
}
return std::holds_alternative<ArrayRef>(ref->u);
} else {
return false;
}
}
template<typename A> std::optional<NamedEntity> ExtractNamedEntity(const A &x) {
if (auto dataRef{ExtractDataRef(x)}) {
return std::visit(

View File

@ -980,7 +980,7 @@ bool Preprocessor::IsIfPredicateTrue(const TokenSequence &expr,
j += 3;
} else if (j + 1 < expr1.SizeInTokens() &&
IsLegalIdentifierStart(expr1.TokenAt(j + 1))) {
name = expr1.TokenAt(j++);
name = expr1.TokenAt(++j);
}
if (!name.empty()) {
char truth{IsNameDefined(name) ? '1' : '0'};

View File

@ -137,14 +137,39 @@ static bool DefersSameTypeParameters(
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
characteristics::TypeAndShape &actualType, bool isElemental,
evaluate::FoldingContext &context, const Scope *scope) {
bool actualIsArrayElement, evaluate::FoldingContext &context,
const Scope *scope) {
// Basic type & rank checking
parser::ContextualMessages &messages{context.messages()};
PadShortCharacterActual(actual, dummy.type, actualType, messages);
ConvertIntegerActual(actual, dummy.type, actualType, messages);
bool typesCompatible{dummy.type.IsCompatibleWith(
messages, actualType, "dummy argument", "actual argument", isElemental)};
bool typesCompatible{
dummy.type.type().IsTypeCompatibleWith(actualType.type())};
if (typesCompatible) {
if (isElemental) {
} else if (dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)) {
} else if (!dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape) &&
(actualType.Rank() > 0 || actualIsArrayElement)) {
// Sequence association (15.5.2.11) applies -- rank need not match
// if the actual argument is an array or array element designator.
} else {
CheckConformance(messages, dummy.type.shape(), actualType.shape(),
"dummy argument", "actual argument");
}
} else {
std::stringstream lenStr;
if (const auto &len{actualType.LEN()}) {
len->AsFortran(lenStr);
}
messages.Say(
"Actual argument type '%s' is not compatible with dummy argument type '%s'"_err_en_US,
actualType.type().AsFortran(lenStr.str()),
dummy.type.type().AsFortran());
}
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
@ -577,7 +602,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
*expr, context)}) {
bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
CheckExplicitDataArg(object, dummyName, *expr, *type,
isElemental, context, scope);
isElemental, IsArrayElement(*expr), context, scope);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(
expr->u)) {

View File

@ -625,7 +625,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
Say("BOZ literal '%s' too large"_err_en_US, x.v);
return std::nullopt;
}
return {AsGenericExpr(std::move(value.value))};
return AsGenericExpr(std::move(value.value));
}
// For use with SearchTypes to create a TypeParamInquiry with the
@ -1677,10 +1677,10 @@ static bool CheckCompatibleArguments(
}
// Resolve a call to a generic procedure with given actual arguments.
// If it's a procedure component, base is the data-ref to the left of the '%'.
// adjustActuals is called on procedure bindings to handle pass arg.
const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
const ActualArguments &actuals, AdjustActuals adjustActuals) {
const ActualArguments &actuals, AdjustActuals adjustActuals,
bool mightBeStructureConstructor, bool inParentType) {
const Symbol *elemental{nullptr}; // matching elemental specific proc
const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
for (const Symbol &specific : details.specificProcs()) {
@ -1711,10 +1711,20 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
if (extended->GetUltimate().has<semantics::GenericDetails>()) {
return ResolveGeneric(*extended, actuals, adjustActuals);
if (const Symbol *
result{ResolveGeneric(
*extended, actuals, adjustActuals, false, true)}) {
return result;
}
}
}
}
if (inParentType) {
return nullptr; // emit error only at top level
}
if (mightBeStructureConstructor && details.derivedType()) {
return details.derivedType();
}
if (semantics::IsGenericDefinedOp(symbol)) {
Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
symbol.name());
@ -1727,12 +1737,13 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
auto ExpressionAnalyzer::GetCalleeAndArguments(
const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
bool isSubroutine) -> std::optional<CalleeAndArguments> {
bool isSubroutine, bool mightBeStructureConstructor)
-> std::optional<CalleeAndArguments> {
return std::visit(
common::visitors{
[&](const parser::Name &name) {
return GetCalleeAndArguments(
name, std::move(arguments), isSubroutine);
return GetCalleeAndArguments(name, std::move(arguments),
isSubroutine, mightBeStructureConstructor);
},
[&](const parser::ProcComponentRef &pcr) {
return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
@ -1741,12 +1752,12 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
pd.u);
}
auto ExpressionAnalyzer::GetCalleeAndArguments(
const parser::Name &name, ActualArguments &&arguments, bool isSubroutine)
-> std::optional<CalleeAndArguments> {
auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
ActualArguments &&arguments, bool isSubroutine,
bool mightBeStructureConstructor) -> std::optional<CalleeAndArguments> {
const Symbol *symbol{name.symbol};
if (context_.HasError(symbol)) {
return std::nullopt;
return std::nullopt; // also handles null symbol
}
const Symbol &ultimate{DEREF(symbol).GetUltimate()};
if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
@ -1756,21 +1767,26 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
} else {
return std::nullopt;
}
} else {
CheckForBadRecursion(name.source, ultimate);
if (ultimate.has<semantics::GenericDetails>()) {
symbol = ResolveGeneric(*symbol, arguments);
symbol = ResolveGeneric(
*symbol, arguments, std::nullopt, mightBeStructureConstructor);
}
if (symbol) {
return CalleeAndArguments{
ProcedureDesignator{*symbol}, std::move(arguments)};
} else {
return std::nullopt;
if (symbol->GetUltimate().has<semantics::DerivedTypeDetails>()) {
if (mightBeStructureConstructor) {
return CalleeAndArguments{
semantics::SymbolRef{*symbol}, std::move(arguments)};
}
} else {
return CalleeAndArguments{
ProcedureDesignator{*symbol}, std::move(arguments)};
}
}
}
return std::nullopt;
}
void ExpressionAnalyzer::CheckForBadRecursion(
@ -1810,46 +1826,67 @@ template<typename A> static const Symbol *AssumedTypeDummy(const A &x) {
return nullptr;
}
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::FunctionReference &funcRef) {
return AnalyzeCall(funcRef.v, false);
}
void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
MaybeExpr expr{AnalyzeCall(callStmt.v, true)};
if (const auto *proc{UnwrapExpr<ProcedureRef>(expr)}) {
callStmt.typedCall.reset(new ProcedureRef{*proc});
}
}
MaybeExpr ExpressionAnalyzer::AnalyzeCall(
const parser::Call &call, bool isSubroutine) {
MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
std::optional<parser::StructureConstructor> *structureConstructor) {
const parser::Call &call{funcRef.v};
auto restorer{GetContextualMessages().SetLocation(call.source)};
ArgumentAnalyzer analyzer{*this};
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
analyzer.Analyze(arg, isSubroutine);
analyzer.Analyze(arg, false /* not subroutine call */);
}
if (!analyzer.fatalErrors()) {
if (std::optional<CalleeAndArguments> callee{
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
analyzer.GetActuals(), isSubroutine)}) {
if (isSubroutine) {
if (CheckCall(
call.source, callee->procedureDesignator, callee->arguments)) {
return Expr<SomeType>{
ProcedureRef{std::move(callee->procedureDesignator),
std::move(callee->arguments)}};
}
} else {
return MakeFunctionRef(call.source,
std::move(callee->procedureDesignator),
std::move(callee->arguments));
if (analyzer.fatalErrors()) {
return std::nullopt;
}
if (std::optional<CalleeAndArguments> callee{
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
analyzer.GetActuals(), false /* not subroutine */,
true /* might be structure constructor */)}) {
if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
return MakeFunctionRef(
call.source, std::move(*proc), std::move(callee->arguments));
} else if (structureConstructor) {
// Structure constructor misparsed as function reference?
CHECK(std::holds_alternative<semantics::SymbolRef>(callee->u));
const Symbol &derivedType{*std::get<semantics::SymbolRef>(callee->u)};
const auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
semantics::Scope &scope{context_.FindScope(name->source)};
const semantics::DeclTypeSpec &type{
semantics::FindOrInstantiateDerivedType(scope,
semantics::DerivedTypeSpec{
name->source, derivedType.GetUltimate()},
context_)};
auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)};
*structureConstructor =
mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec());
return Analyze(structureConstructor->value());
}
}
}
return std::nullopt;
}
void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
const parser::Call &call{callStmt.v};
auto restorer{GetContextualMessages().SetLocation(call.source)};
ArgumentAnalyzer analyzer{*this};
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
analyzer.Analyze(arg, true /* is subroutine call */);
}
if (!analyzer.fatalErrors()) {
if (std::optional<CalleeAndArguments> callee{
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
analyzer.GetActuals(), true /* subroutine */)}) {
ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
CHECK(proc);
if (CheckCall(call.source, *proc, callee->arguments)) {
callStmt.typedCall.reset(
new ProcedureRef{std::move(*proc), std::move(callee->arguments)});
}
}
}
}
const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
if (!x.typedAssignment) {
ArgumentAnalyzer analyzer{*this};
@ -1986,8 +2023,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
analyzer.Analyze(std::get<1>(x.t));
if (!analyzer.fatalErrors()) {
if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
return MakeFunctionRef(name.source,
std::move(callee->procedureDesignator), std::move(callee->arguments));
std::move(std::get<ProcedureDesignator>(callee->u)),
std::move(callee->arguments));
}
}
return std::nullopt;
@ -2073,7 +2112,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
MaybeExpr ExpressionAnalyzer::AnalyzeDefinedOp(
const parser::Name &name, ActualArguments &&actuals) {
if (auto callee{GetCalleeAndArguments(name, std::move(actuals))}) {
return MakeFunctionRef(name.source, std::move(callee->procedureDesignator),
CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
return MakeFunctionRef(name.source,
std::move(std::get<ProcedureDesignator>(callee->u)),
std::move(callee->arguments));
} else {
return std::nullopt;
@ -2160,8 +2201,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
analyzer.Analyze(std::get<2>(x.t));
if (!analyzer.fatalErrors()) {
if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
return MakeFunctionRef(name.source,
std::move(callee->procedureDesignator), std::move(callee->arguments));
std::move(std::get<ProcedureDesignator>(callee->u)),
std::move(callee->arguments));
}
}
return std::nullopt;
@ -2170,7 +2213,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
static void CheckFuncRefToArrayElementRefHasSubscripts(
semantics::SemanticsContext &context,
const parser::FunctionReference &funcRef) {
// Emit message if the function reference fix will end-up an array element
// Emit message if the function reference fix will end up an array element
// reference with no subscripts because it will not be possible to later tell
// the difference in expressions between empty subscript list due to bad
// subscripts error recovery or because the user did not put any.
@ -2196,8 +2239,9 @@ static void CheckFuncRefToArrayElementRefHasSubscripts(
}
// Converts, if appropriate, an original misparse of ambiguous syntax like
// A(1) as a function reference into an array reference or a structure
// constructor.
// A(1) as a function reference into an array reference.
// Misparse structure constructors are detected elsewhere after generic
// function call resolution fails.
template<typename... A>
static void FixMisparsedFunctionReference(
semantics::SemanticsContext &context, const std::variant<A...> &constU) {
@ -2229,30 +2273,6 @@ static void FixMisparsedFunctionReference(
} else {
DIE("can't fix misparsed function as array reference");
}
} else if (const auto *name{std::get_if<parser::Name>(&proc.u)}) {
// A procedure component reference can't be a structure
// constructor; only check calls to bare names.
const Symbol *derivedType{nullptr};
if (symbol.has<semantics::DerivedTypeDetails>()) {
derivedType = &symbol;
} else if (const auto *generic{
symbol.detailsIf<semantics::GenericDetails>()}) {
derivedType = generic->derivedType();
}
if (derivedType) {
if constexpr (common::HasMember<parser::StructureConstructor,
uType>) {
auto &scope{context.FindScope(name->source)};
const semantics::DeclTypeSpec &type{
semantics::FindOrInstantiateDerivedType(scope,
semantics::DerivedTypeSpec{
origSymbol->name(), *derivedType},
context)};
u = funcRef.ConvertToStructureConstructor(type.derivedTypeSpec());
} else {
DIE("can't fix misparsed function as structure constructor");
}
}
}
}
}

View File

@ -255,7 +255,8 @@ private:
MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
MaybeExpr Analyze(const parser::ArrayConstructor &);
MaybeExpr Analyze(const parser::StructureConstructor &);
MaybeExpr Analyze(const parser::FunctionReference &);
MaybeExpr Analyze(const parser::FunctionReference &,
std::optional<parser::StructureConstructor> * = nullptr);
MaybeExpr Analyze(const parser::Expr::Parentheses &);
MaybeExpr Analyze(const parser::Expr::UnaryPlus &);
MaybeExpr Analyze(const parser::Expr::Negate &);
@ -284,7 +285,35 @@ private:
return Analyze(x.u); // default case
}
template<typename... As> MaybeExpr Analyze(const std::variant<As...> &u) {
return std::visit([&](const auto &x) { return Analyze(x); }, u);
return std::visit(
[&](const auto &x) {
using Ty = std::decay_t<decltype(x)>;
// Function references might turn out to be misparsed structure
// constructors; we have to try generic procedure resolution
// first to be sure.
if constexpr (common::IsTypeInList<parser::StructureConstructor,
As...>) {
std::optional<parser::StructureConstructor> ctor;
MaybeExpr result;
if constexpr (std::is_same_v<Ty,
common::Indirection<parser::FunctionReference>>) {
result = Analyze(x.value(), &ctor);
} else if constexpr (std::is_same_v<Ty,
parser::FunctionReference>) {
result = Analyze(x, &ctor);
} else {
return Analyze(x);
}
if (ctor) {
// A misparsed function reference is really a structure
// constructor. Repair the parse tree in situ.
const_cast<std::variant<As...> &>(u) = std::move(*ctor);
}
return result;
}
return Analyze(x);
},
u);
}
// Analysis subroutines
@ -309,7 +338,10 @@ private:
MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
struct CalleeAndArguments {
ProcedureDesignator procedureDesignator;
// A non-component function reference may constitute a misparsed
// structure constructor, in which case its derived type's Symbol
// will appear here.
std::variant<ProcedureDesignator, SymbolRef> u;
ActualArguments arguments;
};
@ -317,20 +349,21 @@ private:
const parser::ProcComponentRef &, ActualArguments &&);
std::optional<ActualArgument> AnalyzeActualArgument(const parser::Expr &);
MaybeExpr AnalyzeCall(const parser::Call &, bool isSubroutine);
std::optional<ActualArguments> AnalyzeArguments(
const parser::Call &, bool isSubroutine);
std::optional<characteristics::Procedure> CheckCall(
parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
using AdjustActuals =
std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
const Symbol *ResolveGeneric(
const Symbol &, const ActualArguments &, AdjustActuals = std::nullopt);
std::optional<CalleeAndArguments> GetCalleeAndArguments(
const parser::Name &, ActualArguments &&, bool isSubroutine = false);
const Symbol *ResolveGeneric(const Symbol &, const ActualArguments &,
AdjustActuals = std::nullopt, bool mightBeStructureConstructor = false,
bool inParentType = false);
std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
ActualArguments &&, bool isSubroutine = false,
bool mightBeStructureConstructor = false);
std::optional<CalleeAndArguments> GetCalleeAndArguments(
const parser::ProcedureDesignator &, ActualArguments &&,
bool isSubroutine);
bool isSubroutine, bool mightBeStructureConstructor = false);
void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,

View File

@ -233,7 +233,7 @@ public:
using RawParameter = std::pair<const parser::Keyword *, ParamValue>;
using RawParameters = std::vector<RawParameter>;
using ParameterMapType = std::map<SourceName, ParamValue>;
explicit DerivedTypeSpec(SourceName, const Symbol &);
DerivedTypeSpec(SourceName, const Symbol &);
DerivedTypeSpec(const DerivedTypeSpec &);
DerivedTypeSpec(DerivedTypeSpec &&);

View File

@ -84,9 +84,9 @@ module m
call sup(pp)
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
call sua(pa)
!ERROR: actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
!ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
call spp(up)
!ERROR: actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
!ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
call spa(ua)
!ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type
call spp(pp2)