forked from OSchip/llvm-project
[flang] Constraint checks C751 to C760
Summary: Many of these were already implemented, and I just annotated the tests and/or the code. C752 was a simple check to verify that CONTIGUOUS components are arrays with C754 proved to be virtually identical to C750 that I implemented previously. This caused me to remove the distinction between specification expressions for type parameters and bounds expressions that I'd previously created. the POINTER attribute. I also changed the error messages to specify that errors in specification expressions could arise from either bad derived type components or type parameters. In cases where we detect a type param that was not declared, I created a symbol marked as erroneous. That avoids subsequent semantic process for expressions containing the symbol. This change caused me to adjust tests resolve33.f90 and resolve34.f90. Also, I avoided putting out error messages for erroneous type param symbols in `OkToAddComponent()` in resolve-names.cpp and in `EvaluateParameters()`, type.cpp. C756 checks that procedure components have the POINTER attribute. Reviewers: tskeith, klausler, DavidTruby Subscribers: llvm-commits Tags: #llvm, #flang Differential Revision: https://reviews.llvm.org/D79798
This commit is contained in:
Pete Steinfeld
parent
7af0c8559b
commit
38095549c6
|
|
@ -43,37 +43,28 @@ bool IsInitialDataTarget(
|
|||
// (10.1.11(2), C1010). Constant expressions are always valid
|
||||
// specification expressions.
|
||||
|
||||
// There are two contexts where specification expressions appear -- array
|
||||
// bounds and type param expressions. We need to differentiate them because
|
||||
// additional checks are required for array bounds expressions in declarations
|
||||
// of derived type components (see C750).
|
||||
ENUM_CLASS(SpecificationExprContext, TYPE_PARAM, BOUND)
|
||||
|
||||
template <typename A>
|
||||
void CheckSpecificationExpr(const A &, parser::ContextualMessages &,
|
||||
const semantics::Scope &, const IntrinsicProcTable &,
|
||||
SpecificationExprContext);
|
||||
const semantics::Scope &, const IntrinsicProcTable &);
|
||||
extern template void CheckSpecificationExpr(const Expr<SomeType> &x,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
extern template void CheckSpecificationExpr(const Expr<SomeInteger> &x,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
extern template void CheckSpecificationExpr(const Expr<SubscriptInteger> &x,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
extern template void CheckSpecificationExpr(
|
||||
const std::optional<Expr<SomeType>> &x, parser::ContextualMessages &,
|
||||
const semantics::Scope &, const IntrinsicProcTable &,
|
||||
SpecificationExprContext);
|
||||
const semantics::Scope &, const IntrinsicProcTable &);
|
||||
extern template void CheckSpecificationExpr(
|
||||
const std::optional<Expr<SomeInteger>> &x, parser::ContextualMessages &,
|
||||
const semantics::Scope &, const IntrinsicProcTable &,
|
||||
SpecificationExprContext);
|
||||
const semantics::Scope &, const IntrinsicProcTable &);
|
||||
extern template void CheckSpecificationExpr(
|
||||
const std::optional<Expr<SubscriptInteger>> &x,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
|
||||
// Simple contiguity (9.5.4)
|
||||
template <typename A>
|
||||
|
|
|
|||
|
|
@ -191,10 +191,9 @@ class CheckSpecificationExprHelper
|
|||
public:
|
||||
using Result = std::optional<std::string>;
|
||||
using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
|
||||
explicit CheckSpecificationExprHelper(const semantics::Scope &s,
|
||||
const IntrinsicProcTable &table, SpecificationExprContext specExprContext)
|
||||
: Base{*this}, scope_{s}, table_{table}, specExprContext_{
|
||||
specExprContext} {}
|
||||
explicit CheckSpecificationExprHelper(
|
||||
const semantics::Scope &s, const IntrinsicProcTable &table)
|
||||
: Base{*this}, scope_{s}, table_{table} {}
|
||||
using Base::operator();
|
||||
|
||||
Result operator()(const ProcedureDesignator &) const {
|
||||
|
|
@ -205,9 +204,9 @@ public:
|
|||
Result operator()(const semantics::Symbol &symbol) const {
|
||||
if (semantics::IsNamedConstant(symbol)) {
|
||||
return std::nullopt;
|
||||
} else if (scope_.IsDerivedType() && IsVariableName(symbol) &&
|
||||
specExprContext_ == SpecificationExprContext::BOUND) { // C750
|
||||
return "derived type component not allowed to reference variable '"s +
|
||||
} else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754
|
||||
return "derived type component or type parameter value not allowed to "
|
||||
"reference variable '"s +
|
||||
symbol.name().ToString() + "'";
|
||||
} else if (symbol.IsDummy()) {
|
||||
if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
|
||||
|
|
@ -256,10 +255,9 @@ public:
|
|||
template <int KIND>
|
||||
Result operator()(const TypeParamInquiry<KIND> &inq) const {
|
||||
if (scope_.IsDerivedType() && !IsConstantExpr(inq) &&
|
||||
inq.parameter().owner() != scope_ &&
|
||||
specExprContext_ == SpecificationExprContext::BOUND) { // C750
|
||||
return "non-constant reference to a type parameter inquiry "
|
||||
"not allowed for derived type components";
|
||||
inq.parameter().owner() != scope_) { // C750, C754
|
||||
return "non-constant reference to a type parameter inquiry not "
|
||||
"allowed for derived type components or type parameter values";
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
|
@ -274,28 +272,30 @@ public:
|
|||
return "reference to statement function '"s +
|
||||
symbol->name().ToString() + "'";
|
||||
}
|
||||
if (scope_.IsDerivedType() &&
|
||||
specExprContext_ == SpecificationExprContext::BOUND) { // C750
|
||||
if (scope_.IsDerivedType()) { // C750, C754
|
||||
return "reference to function '"s + symbol->name().ToString() +
|
||||
"' not allowed for derived type components";
|
||||
"' not allowed for derived type components or type parameter"
|
||||
" values";
|
||||
}
|
||||
// TODO: other checks for standard module procedures
|
||||
} else {
|
||||
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
|
||||
if (scope_.IsDerivedType() &&
|
||||
specExprContext_ == SpecificationExprContext::BOUND) { // C750
|
||||
if (scope_.IsDerivedType()) { // C750, C754
|
||||
if ((table_.IsIntrinsic(intrin.name) &&
|
||||
badIntrinsicsForComponents_.find(intrin.name) !=
|
||||
badIntrinsicsForComponents_.end()) ||
|
||||
IsProhibitedFunction(intrin.name)) {
|
||||
return "reference to intrinsic '"s + intrin.name +
|
||||
"' not allowed for derived type components";
|
||||
"' not allowed for derived type components or type parameter"
|
||||
" values";
|
||||
}
|
||||
if (table_.GetIntrinsicClass(intrin.name) ==
|
||||
IntrinsicClass::inquiryFunction &&
|
||||
!IsConstantExpr(x)) {
|
||||
return "non-constant reference to inquiry intrinsic '"s +
|
||||
intrin.name + "' not allowed for derived type components";
|
||||
intrin.name +
|
||||
"' not allowed for derived type components or type"
|
||||
" parameter values";
|
||||
}
|
||||
} else if (intrin.name == "present") {
|
||||
return std::nullopt; // no need to check argument(s)
|
||||
|
|
@ -311,7 +311,6 @@ public:
|
|||
private:
|
||||
const semantics::Scope &scope_;
|
||||
const IntrinsicProcTable &table_;
|
||||
const SpecificationExprContext specExprContext_;
|
||||
const std::set<std::string> badIntrinsicsForComponents_{
|
||||
"allocated", "associated", "extends_type_of", "present", "same_type_as"};
|
||||
static bool IsProhibitedFunction(std::string name) { return false; }
|
||||
|
|
@ -319,33 +318,30 @@ private:
|
|||
|
||||
template <typename A>
|
||||
void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages,
|
||||
const semantics::Scope &scope, const IntrinsicProcTable &table,
|
||||
SpecificationExprContext specExprContext) {
|
||||
if (auto why{
|
||||
CheckSpecificationExprHelper{scope, table, specExprContext}(x)}) {
|
||||
const semantics::Scope &scope, const IntrinsicProcTable &table) {
|
||||
if (auto why{CheckSpecificationExprHelper{scope, table}(x)}) {
|
||||
messages.Say("Invalid specification expression: %s"_err_en_US, *why);
|
||||
}
|
||||
}
|
||||
|
||||
template void CheckSpecificationExpr(const Expr<SomeType> &,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
template void CheckSpecificationExpr(const Expr<SomeInteger> &,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
template void CheckSpecificationExpr(const Expr<SubscriptInteger> &,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
|
||||
parser::ContextualMessages &, const semantics::Scope &,
|
||||
const IntrinsicProcTable &, SpecificationExprContext);
|
||||
const IntrinsicProcTable &);
|
||||
template void CheckSpecificationExpr(
|
||||
const std::optional<Expr<SubscriptInteger>> &, parser::ContextualMessages &,
|
||||
const semantics::Scope &, const IntrinsicProcTable &,
|
||||
SpecificationExprContext);
|
||||
const semantics::Scope &, const IntrinsicProcTable &);
|
||||
|
||||
// IsSimplyContiguous() -- 9.5.4
|
||||
class IsSimplyContiguousHelper
|
||||
|
|
|
|||
|
|
@ -33,10 +33,7 @@ public:
|
|||
|
||||
void Check() { Check(context_.globalScope()); }
|
||||
void Check(const ParamValue &, bool canBeAssumed);
|
||||
void Check(const Bound &bound) {
|
||||
CheckSpecExpr(
|
||||
bound.GetExplicit(), evaluate::SpecificationExprContext::BOUND);
|
||||
}
|
||||
void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
|
||||
void Check(const ShapeSpec &spec) {
|
||||
Check(spec.lbound());
|
||||
Check(spec.ubound());
|
||||
|
|
@ -47,9 +44,7 @@ public:
|
|||
void Check(const Scope &);
|
||||
|
||||
private:
|
||||
template <typename A>
|
||||
void CheckSpecExpr(
|
||||
const A &x, const evaluate::SpecificationExprContext specExprContext) {
|
||||
template <typename A> void CheckSpecExpr(const A &x) {
|
||||
if (symbolBeingChecked_ && IsSaved(*symbolBeingChecked_)) {
|
||||
if (!evaluate::IsConstantExpr(x)) {
|
||||
messages_.Say(
|
||||
|
|
@ -58,22 +53,18 @@ private:
|
|||
}
|
||||
} else {
|
||||
evaluate::CheckSpecificationExpr(
|
||||
x, messages_, DEREF(scope_), context_.intrinsics(), specExprContext);
|
||||
x, messages_, DEREF(scope_), context_.intrinsics());
|
||||
}
|
||||
}
|
||||
template <typename A>
|
||||
void CheckSpecExpr(const std::optional<A> &x,
|
||||
const evaluate::SpecificationExprContext specExprContext) {
|
||||
template <typename A> void CheckSpecExpr(const std::optional<A> &x) {
|
||||
if (x) {
|
||||
CheckSpecExpr(*x, specExprContext);
|
||||
CheckSpecExpr(*x);
|
||||
}
|
||||
}
|
||||
template <typename A>
|
||||
void CheckSpecExpr(
|
||||
A &x, const evaluate::SpecificationExprContext specExprContext) {
|
||||
template <typename A> void CheckSpecExpr(A &x) {
|
||||
x = Fold(foldingContext_, std::move(x));
|
||||
const A &constx{x};
|
||||
CheckSpecExpr(constx, specExprContext);
|
||||
CheckSpecExpr(constx);
|
||||
}
|
||||
void CheckValue(const Symbol &, const DerivedTypeSpec *);
|
||||
void CheckVolatile(
|
||||
|
|
@ -141,8 +132,7 @@ void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
|
|||
" external function result"_err_en_US);
|
||||
}
|
||||
} else {
|
||||
CheckSpecExpr(
|
||||
value.GetExplicit(), evaluate::SpecificationExprContext::TYPE_PARAM);
|
||||
CheckSpecExpr(value.GetExplicit());
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -294,6 +284,12 @@ void CheckHelper::Check(const Symbol &symbol) {
|
|||
"A dummy argument may not have the SAVE attribute"_err_en_US);
|
||||
}
|
||||
}
|
||||
if (symbol.owner().IsDerivedType() &&
|
||||
(symbol.attrs().test(Attr::CONTIGUOUS) &&
|
||||
!(IsPointer(symbol) && symbol.Rank() > 0))) { // C752
|
||||
messages_.Say(
|
||||
"A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
|
||||
}
|
||||
}
|
||||
|
||||
void CheckHelper::CheckValue(
|
||||
|
|
@ -584,6 +580,12 @@ void CheckHelper::CheckProcEntity(
|
|||
messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
|
||||
}
|
||||
} else if (symbol.owner().IsDerivedType()) {
|
||||
if (!symbol.attrs().test(Attr::POINTER)) { // C756
|
||||
const auto &name{symbol.name()};
|
||||
messages_.Say(name,
|
||||
"Procedure component '%s' must have POINTER attribute"_err_en_US,
|
||||
name);
|
||||
}
|
||||
CheckPassArg(symbol, details.interface().symbol(), details);
|
||||
}
|
||||
if (symbol.attrs().test(Attr::POINTER)) {
|
||||
|
|
@ -1066,7 +1068,7 @@ void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated,
|
|||
|
||||
void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
|
||||
CheckConflicting(symbol, Attr::POINTER, Attr::TARGET);
|
||||
CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE);
|
||||
CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE); // C751
|
||||
CheckConflicting(symbol, Attr::POINTER, Attr::INTRINSIC);
|
||||
if (symbol.Corank() > 0) {
|
||||
messages_.Say(
|
||||
|
|
@ -1076,6 +1078,7 @@ void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
|
|||
}
|
||||
|
||||
// C760 constraints on the passed-object dummy argument
|
||||
// C757 constraints on procedure pointer components
|
||||
void CheckHelper::CheckPassArg(
|
||||
const Symbol &proc, const Symbol *interface, const WithPassArg &details) {
|
||||
if (proc.attrs().test(Attr::NOPASS)) {
|
||||
|
|
@ -1117,7 +1120,7 @@ void CheckHelper::CheckPassArg(
|
|||
break;
|
||||
}
|
||||
}
|
||||
if (!passArgIndex) {
|
||||
if (!passArgIndex) { // C758
|
||||
messages_.Say(*passName,
|
||||
"'%s' is not a dummy argument of procedure interface '%s'"_err_en_US,
|
||||
*passName, interface->name());
|
||||
|
|
|
|||
|
|
@ -3671,6 +3671,13 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
|
|||
if (!symbol) {
|
||||
Say(paramName,
|
||||
"No definition found for type parameter '%s'"_err_en_US); // C742
|
||||
// No symbol for a type param. Create one and mark it as containing an
|
||||
// error to improve subsequent semantic processing
|
||||
BeginAttrs();
|
||||
Symbol *typeParam{MakeTypeSymbol(
|
||||
paramName, TypeParamDetails{common::TypeParamAttr::Len})};
|
||||
typeParam->set(Symbol::Flag::Error);
|
||||
EndAttrs();
|
||||
} else if (!symbol->has<TypeParamDetails>()) {
|
||||
Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US,
|
||||
*symbol, "Definition of '%s'"_en_US); // C741
|
||||
|
|
@ -3906,7 +3913,7 @@ bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
|
|||
CHECK(!interfaceName_);
|
||||
return true;
|
||||
}
|
||||
void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
|
||||
void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &stmt) {
|
||||
interfaceName_ = nullptr;
|
||||
}
|
||||
bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
|
||||
|
|
@ -4682,7 +4689,7 @@ void DeclarationVisitor::SetType(
|
|||
SetType(name,
|
||||
currScope().MakeCharacterType(std::move(length), std::move(kind)));
|
||||
return;
|
||||
} else {
|
||||
} else { // C753
|
||||
Say(name,
|
||||
"A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
|
||||
}
|
||||
|
|
@ -4810,21 +4817,23 @@ bool DeclarationVisitor::OkToAddComponent(
|
|||
for (const Scope *scope{&currScope()}; scope;) {
|
||||
CHECK(scope->IsDerivedType());
|
||||
if (auto *prev{FindInScope(*scope, name)}) {
|
||||
auto msg{""_en_US};
|
||||
if (extends) {
|
||||
msg = "Type cannot be extended as it has a component named"
|
||||
" '%s'"_err_en_US;
|
||||
} else if (prev->test(Symbol::Flag::ParentComp)) {
|
||||
msg = "'%s' is a parent type of this type and so cannot be"
|
||||
" a component"_err_en_US;
|
||||
} else if (scope != &currScope()) {
|
||||
msg = "Component '%s' is already declared in a parent of this"
|
||||
" derived type"_err_en_US;
|
||||
} else {
|
||||
msg = "Component '%s' is already declared in this"
|
||||
" derived type"_err_en_US;
|
||||
if (!prev->test(Symbol::Flag::Error)) {
|
||||
auto msg{""_en_US};
|
||||
if (extends) {
|
||||
msg = "Type cannot be extended as it has a component named"
|
||||
" '%s'"_err_en_US;
|
||||
} else if (prev->test(Symbol::Flag::ParentComp)) {
|
||||
msg = "'%s' is a parent type of this type and so cannot be"
|
||||
" a component"_err_en_US;
|
||||
} else if (scope != &currScope()) {
|
||||
msg = "Component '%s' is already declared in a parent of this"
|
||||
" derived type"_err_en_US;
|
||||
} else {
|
||||
msg = "Component '%s' is already declared in this"
|
||||
" derived type"_err_en_US;
|
||||
}
|
||||
Say2(name, std::move(msg), *prev, "Previous declaration of '%s'"_en_US);
|
||||
}
|
||||
Say2(name, std::move(msg), *prev, "Previous declaration of '%s'"_en_US);
|
||||
return false;
|
||||
}
|
||||
if (scope == &currScope() && extends) {
|
||||
|
|
|
|||
|
|
@ -123,9 +123,12 @@ void DerivedTypeSpec::EvaluateParameters(
|
|||
continue;
|
||||
}
|
||||
}
|
||||
evaluate::SayWithDeclaration(messages, symbol,
|
||||
"Value of type parameter '%s' (%s) is not convertible to its type"_err_en_US,
|
||||
name, expr->AsFortran());
|
||||
if (!symbol.test(Symbol::Flag::Error)) {
|
||||
evaluate::SayWithDeclaration(messages, symbol,
|
||||
"Value of type parameter '%s' (%s) is not convertible to its"
|
||||
" type"_err_en_US,
|
||||
name, expr->AsFortran());
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -147,7 +150,7 @@ void DerivedTypeSpec::EvaluateParameters(
|
|||
auto expr{
|
||||
evaluate::Fold(foldingContext, common::Clone(details.init()))};
|
||||
AddParamValue(name, ParamValue{std::move(*expr), details.attr()});
|
||||
} else {
|
||||
} else if (!symbol.test(Symbol::Flag::Error)) {
|
||||
messages.Say(name_,
|
||||
"Type parameter '%s' lacks a value and has no default"_err_en_US,
|
||||
name);
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ module m1
|
|||
end type
|
||||
contains
|
||||
|
||||
! C853
|
||||
! C852
|
||||
subroutine s0
|
||||
!ERROR: 'p1' may not have both the POINTER and TARGET attributes
|
||||
real, pointer :: p1, p3
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ module m4
|
|||
!ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
|
||||
type(plainType) :: testField1
|
||||
type(sequenceType) :: testField2
|
||||
procedure(real), nopass :: procField
|
||||
procedure(real), pointer, nopass :: procField
|
||||
end type testType
|
||||
!ERROR: A sequence type may not have type parameters
|
||||
type :: paramType(param)
|
||||
|
|
|
|||
|
|
@ -39,7 +39,6 @@ module m
|
|||
!ERROR: No definition found for type parameter 'k'
|
||||
!ERROR: No definition found for type parameter 'l'
|
||||
type :: t6(k, l)
|
||||
!ERROR: Must be a constant value
|
||||
character(kind=k, len=l) :: d3
|
||||
end type
|
||||
type(t6(2, 10)) :: x3
|
||||
|
|
|
|||
|
|
@ -27,9 +27,13 @@ module m3
|
|||
!ERROR: 't1' is a parent type of this type and so cannot be a component
|
||||
real :: t1
|
||||
end type
|
||||
type, extends(t2) :: t3
|
||||
!ERROR: 't1' is a parent type of this type and so cannot be a component
|
||||
real :: t1
|
||||
type :: t3
|
||||
end type
|
||||
type, extends(t3) :: t4
|
||||
end type
|
||||
type, extends(t4) :: t5
|
||||
!ERROR: 't3' is a parent type of this type and so cannot be a component
|
||||
real :: t3
|
||||
end type
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -5,6 +5,13 @@
|
|||
! all of its length type parameters shall be assumed; it shall be polymorphic
|
||||
! (7.3.2.3) if and only if the type being defined is extensible (7.5.7).
|
||||
! It shall not have the VALUE attribute.
|
||||
!
|
||||
! C757 If the procedure pointer component has an implicit interface or has no
|
||||
! arguments, NOPASS shall be specified.
|
||||
!
|
||||
! C758 If PASS (arg-name) appears, the interface of the procedure pointer
|
||||
! component shall have a dummy argument named arg-name.
|
||||
|
||||
|
||||
module m1
|
||||
type :: t
|
||||
|
|
|
|||
|
|
@ -24,6 +24,8 @@ module m
|
|||
procedure(passNopassProc), pass, pointer, nopass :: passNopassField
|
||||
!WARNING: Attribute 'POINTER' cannot be used more than once
|
||||
procedure(pointerProc), pointer, public, pointer :: pointerField
|
||||
!ERROR: Procedure component 'nonpointerfield' must have POINTER attribute
|
||||
procedure(publicProc), public :: nonpointerField
|
||||
contains
|
||||
procedure :: noPassProc
|
||||
procedure :: passProc
|
||||
|
|
|
|||
|
|
@ -1,9 +1,15 @@
|
|||
! RUN: %S/test_errors.sh %s %t %f18
|
||||
! C750 Each bound in the explicit-shape-spec shall be a specification
|
||||
! expression in which there are no references to specification functions or
|
||||
! the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_- TYPE_OF, PRESENT,
|
||||
! the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, PRESENT,
|
||||
! or SAME_TYPE_AS, every specification inquiry reference is a constant
|
||||
! expression, and the value does not depend on the value of a variable.
|
||||
!
|
||||
! C754 Each type-param-value within a component-def-stmt shall be a colon or
|
||||
! a specification expression in which there are no references to specification
|
||||
! functions or the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF,
|
||||
! PRESENT, or SAME_TYPE_AS, every specification inquiry reference is a
|
||||
! constant expression, and the value does not depend on the value of a variable.
|
||||
impure function impureFunc()
|
||||
integer :: impureFunc
|
||||
|
||||
|
|
@ -21,6 +27,7 @@ module m
|
|||
end module m
|
||||
|
||||
subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
|
||||
! C750
|
||||
use m
|
||||
implicit logical(l)
|
||||
integer, intent(in) :: iArg
|
||||
|
|
@ -58,7 +65,7 @@ subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
|
|||
real, dimension(iabs(iArg)) :: arrayVarWithIntrinsic
|
||||
|
||||
type arrayType
|
||||
!ERROR: Invalid specification expression: derived type component not allowed to reference variable 'var'
|
||||
!ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'var'
|
||||
real, dimension(var) :: varField
|
||||
!ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
|
||||
real, dimension(iVolatileStmtFunc()) :: arrayFieldWithVolatile
|
||||
|
|
@ -66,17 +73,17 @@ subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
|
|||
real, dimension(iImpureStmtFunc()) :: arrayFieldWithImpureFunction
|
||||
!ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
|
||||
real, dimension(iPureStmtFunc()) :: arrayFieldWithPureFunction
|
||||
!ERROR: Invalid specification expression: derived type component not allowed to reference variable 'iarg'
|
||||
!ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
|
||||
real, dimension(iabs(iArg)) :: arrayFieldWithIntrinsic
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
|
||||
real, dimension(merge(1, 2, allocated(allocArg))) :: realField1
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
|
||||
real, dimension(merge(1, 2, associated(pointerArg))) :: realField2
|
||||
!ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components
|
||||
!ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
|
||||
real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realField3
|
||||
!ERROR: Invalid specification expression: derived type component not allowed to reference variable 'ioarg'
|
||||
!ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'ioarg'
|
||||
real, dimension(ioArg) :: realField4
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
|
||||
real, dimension(merge(1, 2, present(optionalArg))) :: realField5
|
||||
end type arrayType
|
||||
|
||||
|
|
@ -100,7 +107,7 @@ subroutine s1()
|
|||
type localDerivedType
|
||||
! OK because the specification inquiry is a constant
|
||||
integer, dimension(localDerived%kindParam) :: goodField
|
||||
!ERROR: Invalid specification expression: non-constant reference to a type parameter inquiry not allowed for derived type components
|
||||
!ERROR: Invalid specification expression: non-constant reference to a type parameter inquiry not allowed for derived type components or type parameter values
|
||||
integer, dimension(derivedArg%lenParam) :: badField
|
||||
end type localDerivedType
|
||||
|
||||
|
|
@ -108,3 +115,42 @@ subroutine s1()
|
|||
integer, dimension(derivedArg%kindParam) :: localVar
|
||||
end subroutine inner
|
||||
end subroutine s1
|
||||
|
||||
subroutine s2(iArg, allocArg, pointerArg, arrayArg, optionalArg)
|
||||
! C754
|
||||
integer, intent(in) :: iArg
|
||||
real, allocatable, intent(in) :: allocArg
|
||||
real, pointer, intent(in) :: pointerArg
|
||||
integer, dimension(:), intent(in) :: arrayArg
|
||||
real, optional, intent(in) :: optionalArg
|
||||
|
||||
type paramType(lenParam)
|
||||
integer, len :: lenParam = 4
|
||||
end type paramType
|
||||
|
||||
type charType
|
||||
!ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
|
||||
character(iabs(iArg)) :: fieldWithIntrinsic
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
|
||||
character(merge(1, 2, allocated(allocArg))) :: allocField
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
|
||||
character(merge(1, 2, associated(pointerArg))) :: assocField
|
||||
!ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
|
||||
character(merge(1, 2, is_contiguous(arrayArg))) :: contigField
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
|
||||
character(merge(1, 2, present(optionalArg))) :: presentField
|
||||
end type charType
|
||||
|
||||
type derivedType
|
||||
!ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
|
||||
type(paramType(iabs(iArg))) :: fieldWithIntrinsic
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
|
||||
type(paramType(merge(1, 2, allocated(allocArg)))) :: allocField
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
|
||||
type(paramType(merge(1, 2, associated(pointerArg)))) :: assocField
|
||||
!ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
|
||||
type(paramType(merge(1, 2, is_contiguous(arrayArg)))) :: contigField
|
||||
!ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
|
||||
type(paramType(merge(1, 2, present(optionalArg)))) :: presentField
|
||||
end type derivedType
|
||||
end subroutine s2
|
||||
|
|
|
|||
|
|
@ -0,0 +1,18 @@
|
|||
! RUN: %S/test_errors.sh %s %t %f18
|
||||
! C751 A component shall not have both the ALLOCATABLE and POINTER attributes.
|
||||
! C752 If the CONTIGUOUS attribute is specified, the component shall be an
|
||||
! array with the POINTER attribute.
|
||||
! C753 The * char-length option is permitted only if the component is of type
|
||||
! character.
|
||||
subroutine s()
|
||||
type derivedType
|
||||
!ERROR: 'pointerallocatablefield' may not have both the POINTER and ALLOCATABLE attributes
|
||||
real, pointer, allocatable :: pointerAllocatableField
|
||||
real, dimension(:), contiguous, pointer :: goodContigField
|
||||
!ERROR: A CONTIGUOUS component must be an array with the POINTER attribute
|
||||
real, dimension(:), contiguous, allocatable :: badContigField
|
||||
character :: charField * 3
|
||||
!ERROR: A length specifier cannot be used to declare the non-character entity 'realfield'
|
||||
real :: realField * 3
|
||||
end type derivedType
|
||||
end subroutine s
|
||||
Loading…
Reference in New Issue