[flang] Allow restricted specific intrinsic functions as implicitly-interfaced procedure pointer targets
The predicate "CanBeCalledViaImplicitInterface()" was returning false for restricted specific intrinsic functions (e.g., SIN) because their procedure characteristics have the elemental attribute; this leads to a bogus semantic error when one attempts to use them as proc-targets in procedure pointer assignment statements when the left-hand side of the assignment is a procedure pointer with an implicit interface. However, these restricted specific intrinsic functions have always been allowed as special cases for such usage -- it is as if they are elemental when it is necessary for them to be so, but not when it's a problem. Differential Revision: https://reviews.llvm.org/D130386
This commit is contained in:
parent
ae1d5f4d9d
commit
95f4ca7f5d
|
@ -333,7 +333,8 @@ struct Procedure {
|
|||
int FindPassIndex(std::optional<parser::CharBlock>) const;
|
||||
bool CanBeCalledViaImplicitInterface() const;
|
||||
bool CanOverride(const Procedure &, std::optional<int> passIndex) const;
|
||||
bool IsCompatibleWith(const Procedure &, std::string *whyNot = nullptr) const;
|
||||
bool IsCompatibleWith(const Procedure &, std::string *whyNot = nullptr,
|
||||
const SpecificIntrinsic * = nullptr) const;
|
||||
|
||||
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
|
||||
|
||||
|
|
|
@ -1026,7 +1026,7 @@ template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
|
|||
std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
|
||||
const std::optional<characteristics::Procedure> &lhsProcedure,
|
||||
const characteristics::Procedure *rhsProcedure,
|
||||
std::string &whyNotCompatible);
|
||||
const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible);
|
||||
|
||||
// Scalar constant expansion
|
||||
class ScalarConstantExpander {
|
||||
|
|
|
@ -16,6 +16,7 @@
|
|||
#include "flang/Parser/message.h"
|
||||
#include "flang/Semantics/scope.h"
|
||||
#include "flang/Semantics/symbol.h"
|
||||
#include "flang/Semantics/tools.h"
|
||||
#include "llvm/Support/raw_ostream.h"
|
||||
#include <initializer_list>
|
||||
|
||||
|
@ -440,9 +441,11 @@ static std::optional<Procedure> CharacterizeProcedure(
|
|||
return std::nullopt;
|
||||
}
|
||||
seenProcs.insert(symbol);
|
||||
if (IsElementalProcedure(symbol)) {
|
||||
result.attrs.set(Procedure::Attr::Elemental);
|
||||
}
|
||||
CopyAttrs<Procedure, Procedure::Attr>(symbol, result,
|
||||
{
|
||||
{semantics::Attr::ELEMENTAL, Procedure::Attr::Elemental},
|
||||
{semantics::Attr::BIND_C, Procedure::Attr::BindC},
|
||||
});
|
||||
if (IsPureProcedure(symbol) || // works for ENTRY too
|
||||
|
@ -498,8 +501,13 @@ static std::optional<Procedure> CharacterizeProcedure(
|
|||
}
|
||||
const semantics::ProcInterface &interface { proc.interface() };
|
||||
if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
|
||||
return CharacterizeProcedure(
|
||||
*interfaceSymbol, context, seenProcs);
|
||||
auto interface {
|
||||
CharacterizeProcedure(*interfaceSymbol, context, seenProcs)
|
||||
};
|
||||
if (interface && IsPointer(symbol)) {
|
||||
interface->attrs.reset(Procedure::Attr::Elemental);
|
||||
}
|
||||
return interface;
|
||||
} else {
|
||||
result.attrs.set(Procedure::Attr::ImplicitInterface);
|
||||
const semantics::DeclTypeSpec *type{interface.type()};
|
||||
|
@ -938,15 +946,15 @@ bool Procedure::operator==(const Procedure &that) const {
|
|||
dummyArguments == that.dummyArguments;
|
||||
}
|
||||
|
||||
bool Procedure::IsCompatibleWith(
|
||||
const Procedure &actual, std::string *whyNot) const {
|
||||
bool Procedure::IsCompatibleWith(const Procedure &actual, std::string *whyNot,
|
||||
const SpecificIntrinsic *specificIntrinsic) const {
|
||||
// 15.5.2.9(1): if dummy is not pure, actual need not be.
|
||||
// Ditto with elemental.
|
||||
Attrs actualAttrs{actual.attrs};
|
||||
if (!attrs.test(Attr::Pure)) {
|
||||
actualAttrs.reset(Attr::Pure);
|
||||
}
|
||||
if (!attrs.test(Attr::Elemental)) {
|
||||
if (!attrs.test(Attr::Elemental) && specificIntrinsic) {
|
||||
actualAttrs.reset(Attr::Elemental);
|
||||
}
|
||||
Attrs differences{attrs ^ actualAttrs};
|
||||
|
|
|
@ -2147,10 +2147,8 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
|
|||
if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) {
|
||||
CHECK(arguments.size() == 3);
|
||||
if (const auto *expr{arguments[0].value().UnwrapExpr()}) {
|
||||
if (expr->Rank() > 0) {
|
||||
context.messages().Say(arguments[0]->sourceLocation(),
|
||||
"CPTR= argument to C_F_POINTER() must be scalar"_err_en_US);
|
||||
}
|
||||
// General semantic checks will catch an actual argument that's not
|
||||
// scalar.
|
||||
if (auto type{expr->GetType()}) {
|
||||
if (type->category() != TypeCategory::Derived ||
|
||||
type->IsPolymorphic() ||
|
||||
|
@ -2231,6 +2229,8 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
|
|||
if (const auto &targetArg{call.arguments[1]}) {
|
||||
if (const auto *targetExpr{targetArg->UnwrapExpr()}) {
|
||||
std::optional<characteristics::Procedure> pointerProc, targetProc;
|
||||
const auto *targetProcDesignator{
|
||||
UnwrapExpr<ProcedureDesignator>(*targetExpr)};
|
||||
const Symbol *targetSymbol{GetLastSymbol(*targetExpr)};
|
||||
bool isCall{false};
|
||||
std::string targetName;
|
||||
|
@ -2243,6 +2243,10 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
|
|||
targetName = targetProcRef->proc().GetName() + "()";
|
||||
isCall = true;
|
||||
}
|
||||
} else if (targetProcDesignator) {
|
||||
targetProc = characteristics::Procedure::Characterize(
|
||||
*targetProcDesignator, context);
|
||||
targetName = targetProcDesignator->GetName();
|
||||
} else if (targetSymbol) {
|
||||
// proc that's not a call
|
||||
if (IsProcedure(*targetSymbol)) {
|
||||
|
@ -2259,9 +2263,14 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
|
|||
if (targetProc) {
|
||||
// procedure pointer and procedure target
|
||||
std::string whyNot;
|
||||
const SpecificIntrinsic *specificIntrinsic{nullptr};
|
||||
if (targetProcDesignator) {
|
||||
specificIntrinsic =
|
||||
targetProcDesignator->GetSpecificIntrinsic();
|
||||
}
|
||||
if (std::optional<parser::MessageFixedText> msg{
|
||||
CheckProcCompatibility(
|
||||
isCall, pointerProc, &*targetProc, whyNot)}) {
|
||||
CheckProcCompatibility(isCall, pointerProc,
|
||||
&*targetProc, specificIntrinsic, whyNot)}) {
|
||||
msg->set_severity(parser::Severity::Warning);
|
||||
AttachDeclaration(
|
||||
context.messages().Say(std::move(*msg),
|
||||
|
|
|
@ -946,7 +946,7 @@ std::optional<std::string> FindImpureCall(
|
|||
std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
|
||||
const std::optional<characteristics::Procedure> &lhsProcedure,
|
||||
const characteristics::Procedure *rhsProcedure,
|
||||
std::string &whyNotCompatible) {
|
||||
const SpecificIntrinsic *specificIntrinsic, std::string &whyNotCompatible) {
|
||||
std::optional<parser::MessageFixedText> msg;
|
||||
if (!lhsProcedure) {
|
||||
msg = "In assignment to object %s, the target '%s' is a procedure"
|
||||
|
@ -954,7 +954,8 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
|
|||
} else if (!rhsProcedure) {
|
||||
msg = "In assignment to procedure %s, the characteristics of the target"
|
||||
" procedure '%s' could not be determined"_err_en_US;
|
||||
} else if (lhsProcedure->IsCompatibleWith(*rhsProcedure, &whyNotCompatible)) {
|
||||
} else if (lhsProcedure->IsCompatibleWith(
|
||||
*rhsProcedure, &whyNotCompatible, specificIntrinsic)) {
|
||||
// OK
|
||||
} else if (isCall) {
|
||||
msg = "Procedure %s associated with result of reference to function '%s'"
|
||||
|
@ -971,8 +972,8 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
|
|||
} else if (lhsProcedure->HasExplicitInterface() &&
|
||||
!rhsProcedure->HasExplicitInterface()) {
|
||||
// Section 10.2.2.4, paragraph 3 prohibits associating a procedure pointer
|
||||
// with an explicit interface with a procedure whose characteristics don't
|
||||
// match. That's the case if the target procedure has an implicit
|
||||
// that has an explicit interface with a procedure whose characteristics
|
||||
// don't match. That's the case if the target procedure has an implicit
|
||||
// interface. But this case is allowed by several other compilers as long
|
||||
// as the explicit interface can be called via an implicit interface.
|
||||
if (!lhsProcedure->CanBeCalledViaImplicitInterface()) {
|
||||
|
@ -983,7 +984,8 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
|
|||
} else if (!lhsProcedure->HasExplicitInterface() &&
|
||||
rhsProcedure->HasExplicitInterface()) {
|
||||
// OK if the target can be called via an implicit interface
|
||||
if (!rhsProcedure->CanBeCalledViaImplicitInterface()) {
|
||||
if (!rhsProcedure->CanBeCalledViaImplicitInterface() &&
|
||||
!specificIntrinsic) {
|
||||
msg = "Procedure %s with implicit interface may not be associated "
|
||||
"with procedure designator '%s' with explicit interface that "
|
||||
"cannot be called via an implicit interface"_err_en_US;
|
||||
|
|
|
@ -192,20 +192,21 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
if (isElemental) {
|
||||
} else if (dummy.type.attrs().test(
|
||||
characteristics::TypeAndShape::Attr::AssumedRank)) {
|
||||
} else if (!dummy.type.attrs().test(
|
||||
characteristics::TypeAndShape::Attr::AssumedShape) &&
|
||||
} else if (dummy.type.Rank() > 0 &&
|
||||
!dummy.type.attrs().test(
|
||||
characteristics::TypeAndShape::Attr::AssumedShape) &&
|
||||
!dummy.type.attrs().test(
|
||||
characteristics::TypeAndShape::Attr::DeferredShape) &&
|
||||
(actualType.Rank() > 0 || IsArrayElement(actual))) {
|
||||
// Sequence association (15.5.2.11) applies -- rank need not match
|
||||
// if the actual argument is an array or array element designator,
|
||||
// and the dummy is not assumed-shape or an INTENT(IN) pointer
|
||||
// that's standing in for an assumed-shape dummy.
|
||||
// and the dummy is an array, but not assumed-shape or an INTENT(IN)
|
||||
// pointer that's standing in for an assumed-shape dummy.
|
||||
} else {
|
||||
// Let CheckConformance accept scalars; storage association
|
||||
// Let CheckConformance accept actual scalars; storage association
|
||||
// cases are checked here below.
|
||||
CheckConformance(messages, dummy.type.shape(), actualType.shape(),
|
||||
evaluate::CheckConformanceFlags::EitherScalarExpandable,
|
||||
evaluate::CheckConformanceFlags::RightScalarExpandable,
|
||||
"dummy argument", "actual argument");
|
||||
}
|
||||
} else {
|
||||
|
|
|
@ -67,8 +67,9 @@ private:
|
|||
bool Check(const evaluate::ProcedureDesignator &);
|
||||
bool Check(const evaluate::ProcedureRef &);
|
||||
// Target is a procedure
|
||||
bool Check(
|
||||
parser::CharBlock rhsName, bool isCall, const Procedure * = nullptr);
|
||||
bool Check(parser::CharBlock rhsName, bool isCall,
|
||||
const Procedure * = nullptr,
|
||||
const evaluate::SpecificIntrinsic *specific = nullptr);
|
||||
bool LhsOkForUnlimitedPoly() const;
|
||||
template <typename... A> parser::Message *Say(A &&...);
|
||||
|
||||
|
@ -255,11 +256,12 @@ bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
|
|||
}
|
||||
|
||||
// Common handling for procedure pointer right-hand sides
|
||||
bool PointerAssignmentChecker::Check(
|
||||
parser::CharBlock rhsName, bool isCall, const Procedure *rhsProcedure) {
|
||||
bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
|
||||
const Procedure *rhsProcedure,
|
||||
const evaluate::SpecificIntrinsic *specific) {
|
||||
std::string whyNot;
|
||||
if (std::optional<MessageFixedText> msg{evaluate::CheckProcCompatibility(
|
||||
isCall, procedure_, rhsProcedure, whyNot)}) {
|
||||
isCall, procedure_, rhsProcedure, specific, whyNot)}) {
|
||||
Say(std::move(*msg), description_, rhsName, whyNot);
|
||||
return false;
|
||||
}
|
||||
|
@ -268,24 +270,23 @@ bool PointerAssignmentChecker::Check(
|
|||
|
||||
bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
|
||||
if (auto chars{Procedure::Characterize(d, context_)}) {
|
||||
return Check(d.GetName(), false, &*chars);
|
||||
return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
|
||||
} else {
|
||||
return Check(d.GetName(), false);
|
||||
}
|
||||
}
|
||||
|
||||
bool PointerAssignmentChecker::Check(const evaluate::ProcedureRef &ref) {
|
||||
const Procedure *procedure{nullptr};
|
||||
auto chars{Procedure::Characterize(ref, context_)};
|
||||
if (chars) {
|
||||
procedure = &*chars;
|
||||
if (auto chars{Procedure::Characterize(ref, context_)}) {
|
||||
if (chars->functionResult) {
|
||||
if (const auto *proc{chars->functionResult->IsProcedurePointer()}) {
|
||||
procedure = proc;
|
||||
return Check(ref.proc().GetName(), true, proc);
|
||||
}
|
||||
}
|
||||
return Check(ref.proc().GetName(), true, &*chars);
|
||||
} else {
|
||||
return Check(ref.proc().GetName(), true, nullptr);
|
||||
}
|
||||
return Check(ref.proc().GetName(), true, procedure);
|
||||
}
|
||||
|
||||
// The target can be unlimited polymorphic if the pointer is, or if it is
|
||||
|
|
|
@ -74,37 +74,42 @@ contains
|
|||
|
||||
p_impure => f_impure1 ! OK, same characteristics
|
||||
p_impure => f_pure1 ! OK, target may be pure when pointer is not
|
||||
p_impure => f_elemental1 ! OK, target may be pure elemental
|
||||
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental1': incompatible procedure attributes: Elemental
|
||||
p_impure => f_elemental1
|
||||
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impureelemental1': incompatible procedure attributes: Elemental
|
||||
p_impure => f_ImpureElemental1 ! OK, target may be elemental
|
||||
|
||||
sp_impure => s_impure1 ! OK, same characteristics
|
||||
sp_impure => s_pure1 ! OK, target may be pure when pointer is not
|
||||
sp_impure => s_elemental1 ! OK, target may be elemental when pointer is not
|
||||
!ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_elemental1': incompatible procedure attributes: Elemental
|
||||
sp_impure => s_elemental1
|
||||
|
||||
!ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impure1'
|
||||
p_pure => f_impure1
|
||||
p_pure => f_pure1 ! OK, same characteristics
|
||||
p_pure => f_elemental1 ! OK, target may be pure
|
||||
!ERROR: Procedure pointer 'p_pure' associated with incompatible procedure designator 'f_elemental1': incompatible procedure attributes: Elemental
|
||||
p_pure => f_elemental1
|
||||
!ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impureelemental1'
|
||||
p_pure => f_impureElemental1
|
||||
|
||||
!ERROR: PURE procedure pointer 'sp_pure' may not be associated with non-PURE procedure designator 's_impure1'
|
||||
sp_pure => s_impure1
|
||||
sp_pure => s_pure1 ! OK, same characteristics
|
||||
!ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental1': incompatible procedure attributes: Elemental
|
||||
sp_pure => s_elemental1 ! OK, target may be elemental when pointer is not
|
||||
|
||||
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impure2': incompatible dummy argument #1: incompatible dummy data object intents
|
||||
p_impure => f_impure2
|
||||
!ERROR: Procedure pointer 'p_pure' associated with incompatible procedure designator 'f_pure2': function results have incompatible types: INTEGER(4) vs REAL(4)
|
||||
p_pure => f_pure2
|
||||
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental2': incompatible dummy argument #1: incompatible dummy data object attributes
|
||||
!ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental2': incompatible procedure attributes: Elemental
|
||||
p_impure => f_elemental2
|
||||
|
||||
!ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_impure2': incompatible procedure attributes: BindC
|
||||
sp_impure => s_impure2
|
||||
!ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_pure2': incompatible dummy argument #1: incompatible dummy data object intents
|
||||
sp_impure => s_pure2
|
||||
!ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental2': distinct numbers of dummy arguments
|
||||
!ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental2': incompatible procedure attributes: Elemental
|
||||
sp_pure => s_elemental2
|
||||
|
||||
!ERROR: Function pointer 'p_impure' may not be associated with subroutine designator 's_impure1'
|
||||
|
|
68
flang/test/Semantics/assign09.f90
Normal file
68
flang/test/Semantics/assign09.f90
Normal file
|
@ -0,0 +1,68 @@
|
|||
! RUN: %python %S/test_errors.py %s %flang_fc1
|
||||
! Procedure pointer assignments and argument association with intrinsic functions
|
||||
program test
|
||||
abstract interface
|
||||
real function realToReal(a)
|
||||
real, intent(in) :: a
|
||||
end function
|
||||
real function intToReal(n)
|
||||
integer, intent(in) :: n
|
||||
end function
|
||||
end interface
|
||||
procedure(), pointer :: noInterfaceProcPtr
|
||||
procedure(realToReal), pointer :: realToRealProcPtr
|
||||
procedure(intToReal), pointer :: intToRealProcPtr
|
||||
intrinsic :: float ! restricted specific intrinsic functions
|
||||
intrinsic :: sqrt ! unrestricted specific intrinsic functions
|
||||
external :: noInterfaceExternal
|
||||
interface
|
||||
elemental real function userElemental(a)
|
||||
real, intent(in) :: a
|
||||
end function
|
||||
end interface
|
||||
|
||||
!ERROR: 'float' is not an unrestricted specific intrinsic procedure
|
||||
noInterfaceProcPtr => float
|
||||
!ERROR: 'float' is not an unrestricted specific intrinsic procedure
|
||||
intToRealProcPtr => float
|
||||
!ERROR: 'float' is not an unrestricted specific intrinsic procedure
|
||||
call sub1(float)
|
||||
!ERROR: 'float' is not an unrestricted specific intrinsic procedure
|
||||
call sub2(float)
|
||||
!ERROR: 'float' is not an unrestricted specific intrinsic procedure
|
||||
call sub3(float)
|
||||
|
||||
noInterfaceProcPtr => sqrt ! ok
|
||||
realToRealProcPtr => sqrt ! ok
|
||||
!ERROR: Procedure pointer 'inttorealprocptr' associated with incompatible procedure designator 'sqrt': incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4)
|
||||
intToRealProcPtr => sqrt
|
||||
call sub1(sqrt) ! ok
|
||||
call sub2(sqrt) ! ok
|
||||
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4)
|
||||
call sub3(sqrt)
|
||||
|
||||
noInterfaceProcPtr => noInterfaceExternal ! ok
|
||||
realToRealProcPtr => noInterfaceExternal ! ok
|
||||
intToRealProcPtr => noInterfaceExternal !ok
|
||||
call sub1(noInterfaceExternal) ! ok
|
||||
!WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
|
||||
call sub2(noInterfaceExternal)
|
||||
!WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
|
||||
call sub3(noInterfaceExternal)
|
||||
|
||||
!ERROR: Procedure pointer 'nointerfaceprocptr' with implicit interface may not be associated with procedure designator 'userelemental' with explicit interface that cannot be called via an implicit interface
|
||||
noInterfaceProcPtr => userElemental
|
||||
!ERROR: Non-intrinsic ELEMENTAL procedure 'userelemental' may not be passed as an actual argument
|
||||
call sub1(userElemental)
|
||||
|
||||
contains
|
||||
subroutine sub1(p)
|
||||
external :: p
|
||||
end subroutine
|
||||
subroutine sub2(p)
|
||||
procedure(realToReal) :: p
|
||||
end subroutine
|
||||
subroutine sub3(p)
|
||||
procedure(intToReal) :: p
|
||||
end subroutine
|
||||
end
|
|
@ -135,7 +135,7 @@ subroutine assoc()
|
|||
intprocPointer1 => intVar
|
||||
!ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
|
||||
lVar = associated(intprocPointer1, intVar)
|
||||
!ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible dummy argument #1: incompatible dummy data object attributes
|
||||
!ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
|
||||
intProcPointer1 => elementalProc
|
||||
!WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible dummy argument #1: incompatible dummy data object attributes
|
||||
lvar = associated(intProcPointer1, elementalProc)
|
||||
|
|
|
@ -19,7 +19,7 @@ program test
|
|||
call c_f_pointer(scalarC, fptr=arrayIntF, [1_8])
|
||||
!ERROR: CPTR= argument to C_F_POINTER() must be a C_PTR
|
||||
call c_f_pointer(j, scalarIntF)
|
||||
!ERROR: CPTR= argument to C_F_POINTER() must be scalar
|
||||
!ERROR: Rank of dummy argument is 0, but actual argument has rank 1
|
||||
call c_f_pointer(arrayC, scalarIntF)
|
||||
!ERROR: SHAPE= argument to C_F_POINTER() must appear when FPTR= is an array
|
||||
call c_f_pointer(scalarC, arrayIntF)
|
||||
|
|
|
@ -59,18 +59,30 @@ module m01
|
|||
subroutine intentout(x)
|
||||
real, intent(out) :: x
|
||||
end subroutine
|
||||
subroutine intentout_arr(x)
|
||||
real, intent(out) :: x(:)
|
||||
end subroutine
|
||||
subroutine intentinout(x)
|
||||
real, intent(in out) :: x
|
||||
end subroutine
|
||||
subroutine intentinout_arr(x)
|
||||
real, intent(in out) :: x(:)
|
||||
end subroutine
|
||||
subroutine asynchronous(x)
|
||||
real, asynchronous :: x
|
||||
end subroutine
|
||||
subroutine asynchronous_arr(x)
|
||||
real, asynchronous :: x(:)
|
||||
end subroutine
|
||||
subroutine asynchronousValue(x)
|
||||
real, asynchronous, value :: x
|
||||
end subroutine
|
||||
subroutine volatile(x)
|
||||
real, volatile :: x
|
||||
end subroutine
|
||||
subroutine volatile_arr(x)
|
||||
real, volatile :: x(:)
|
||||
end subroutine
|
||||
subroutine pointer(x)
|
||||
real, pointer :: x(:)
|
||||
end subroutine
|
||||
|
@ -91,7 +103,7 @@ module m01
|
|||
end subroutine
|
||||
|
||||
subroutine mono(x)
|
||||
type(t), intent(in) :: x
|
||||
type(t), intent(in) :: x(*)
|
||||
end subroutine
|
||||
subroutine test02(x) ! 15.5.2.4(2)
|
||||
class(t), intent(in) :: x(*)
|
||||
|
@ -269,13 +281,13 @@ module m01
|
|||
integer :: j(1)
|
||||
j(1) = 1
|
||||
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
|
||||
call intentout(a(j))
|
||||
call intentout_arr(a(j))
|
||||
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
|
||||
call intentinout(a(j))
|
||||
call intentinout_arr(a(j))
|
||||
!ERROR: Actual argument associated with ASYNCHRONOUS dummy argument 'x=' must be definable
|
||||
call asynchronous(a(j))
|
||||
call asynchronous_arr(a(j))
|
||||
!ERROR: Actual argument associated with VOLATILE dummy argument 'x=' must be definable
|
||||
call volatile(a(j))
|
||||
call volatile_arr(a(j))
|
||||
end subroutine
|
||||
|
||||
subroutine coarr(x)
|
||||
|
|
23
flang/test/Semantics/procinterface02.f90
Normal file
23
flang/test/Semantics/procinterface02.f90
Normal file
|
@ -0,0 +1,23 @@
|
|||
! RUN: %python %S/test_errors.py %s %flang_fc1
|
||||
subroutine foo(A, B, P)
|
||||
interface
|
||||
real elemental function foo_elemental(x)
|
||||
real, intent(in) :: x
|
||||
end function
|
||||
pure real function foo_pure(x)
|
||||
real, intent(in) :: x
|
||||
end function
|
||||
real function foo_nonelemental(x)
|
||||
real, intent(in) :: x
|
||||
end function
|
||||
end interface
|
||||
real :: A(:), B(:)
|
||||
procedure(sqrt), pointer :: P
|
||||
!ERROR: Rank of dummy argument is 0, but actual argument has rank 1
|
||||
A = P(B)
|
||||
!ERROR: Procedure pointer 'p' associated with incompatible procedure designator 'foo_elemental': incompatible procedure attributes: Elemental
|
||||
P => foo_elemental
|
||||
P => foo_pure ! ok
|
||||
!ERROR: PURE procedure pointer 'p' may not be associated with non-PURE procedure designator 'foo_nonelemental'
|
||||
P => foo_nonelemental
|
||||
end subroutine
|
Loading…
Reference in a new issue