forked from OSchip/llvm-project
[flang] Changes to enforce constraints C727 to C730 and most constraints related to attributes
The full list of constraints is C727, C728, C729, C730, C743, C755, C759, C778, and C1543. I added a function to tools.cpp to check to see if a symbol name is the name of an intrinsic type. The biggest change was to resolve-names.cpp to check to see if attributes were either duplicated or in conflict with each other. I changed all locations where attributes were set to check for duplicates or conflicts. I also added tests for all checks and annotated the tests and code with the numbers of the constraints being tested/checked. Original-commit: flang-compiler/f18@3f30e8a61e Reviewed-on: https://github.com/flang-compiler/f18/pull/1084
This commit is contained in:
Pete Steinfeld
parent
23c227a971
commit
e17e71735e
|
|
@ -22,10 +22,10 @@ namespace Fortran::semantics {
|
|||
|
||||
// All available attributes.
|
||||
ENUM_CLASS(Attr, ABSTRACT, ALLOCATABLE, ASYNCHRONOUS, BIND_C, CONTIGUOUS,
|
||||
DEFERRED, ELEMENTAL, EXTERNAL, IMPURE, INTENT_IN, INTENT_INOUT, INTENT_OUT,
|
||||
INTRINSIC, MODULE, NON_OVERRIDABLE, NON_RECURSIVE, NOPASS, OPTIONAL,
|
||||
PARAMETER, PASS, POINTER, PRIVATE, PROTECTED, PUBLIC, PURE, RECURSIVE, SAVE,
|
||||
TARGET, VALUE, VOLATILE)
|
||||
DEFERRED, ELEMENTAL, EXTENDS, EXTERNAL, IMPURE, INTENT_IN, INTENT_INOUT,
|
||||
INTENT_OUT, INTRINSIC, MODULE, NON_OVERRIDABLE, NON_RECURSIVE, NOPASS,
|
||||
OPTIONAL, PARAMETER, PASS, POINTER, PRIVATE, PROTECTED, PUBLIC, PURE,
|
||||
RECURSIVE, SAVE, TARGET, VALUE, VOLATILE)
|
||||
|
||||
// Set of attributes
|
||||
class Attrs : public common::EnumSet<Attr, Attr_enumSize> {
|
||||
|
|
|
|||
|
|
@ -107,6 +107,7 @@ bool IsOrContainsEventOrLockComponent(const Symbol &);
|
|||
bool IsSaved(const Symbol &);
|
||||
bool CanBeTypeBoundProc(const Symbol *);
|
||||
bool IsInitialized(const Symbol &);
|
||||
bool HasIntrinsicTypeName(const Symbol &);
|
||||
|
||||
// Return an ultimate component of type that matches predicate, or nullptr.
|
||||
const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
|
||||
|
|
|
|||
|
|
@ -641,6 +641,10 @@ void CheckHelper::CheckDerivedType(
|
|||
}
|
||||
}
|
||||
}
|
||||
if (HasIntrinsicTypeName(symbol)) { // C729
|
||||
messages_.Say("A derived type name cannot be the name of an intrinsic"
|
||||
" type"_err_en_US);
|
||||
}
|
||||
}
|
||||
|
||||
void CheckHelper::CheckGeneric(
|
||||
|
|
|
|||
|
|
@ -626,7 +626,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::LogicalLiteralConstant &x) {
|
|||
TypeKindVisitor<TypeCategory::Logical, Constant, bool>{
|
||||
kind, std::move(value)})};
|
||||
if (!result) {
|
||||
Say("unsupported LOGICAL(KIND=%d)"_err_en_US, kind);
|
||||
Say("unsupported LOGICAL(KIND=%d)"_err_en_US, kind); // C728
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
|
@ -2494,7 +2494,7 @@ DynamicType ExpressionAnalyzer::GetDefaultKindOfType(
|
|||
|
||||
bool ExpressionAnalyzer::CheckIntrinsicKind(
|
||||
TypeCategory category, std::int64_t kind) {
|
||||
if (IsValidKindOfIntrinsicType(category, kind)) { // C712, C714, C715
|
||||
if (IsValidKindOfIntrinsicType(category, kind)) { // C712, C714, C715, C727
|
||||
return true;
|
||||
} else {
|
||||
Say("%s(KIND=%jd) is not a supported type"_err_en_US,
|
||||
|
|
@ -2543,7 +2543,7 @@ bool ExpressionAnalyzer::EnforceTypeConstraint(parser::CharBlock at,
|
|||
const MaybeExpr &result, TypeCategory category, bool defaultKind) {
|
||||
if (result) {
|
||||
if (auto type{result->GetType()}) {
|
||||
if (type->category() != category) { // C885
|
||||
if (type->category() != category) { // C885
|
||||
Say(at, "Must have %s type, but is %s"_err_en_US,
|
||||
ToUpperCase(EnumToString(category)),
|
||||
ToUpperCase(type->AsFortran()));
|
||||
|
|
|
|||
|
|
@ -242,10 +242,12 @@ public:
|
|||
bool Pre(const parser::IntentSpec &);
|
||||
bool Pre(const parser::Pass &);
|
||||
|
||||
bool CheckAndSet(Attr);
|
||||
|
||||
// Simple case: encountering CLASSNAME causes ATTRNAME to be set.
|
||||
#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
|
||||
bool Pre(const parser::CLASSNAME &) { \
|
||||
attrs_->set(Attr::ATTRNAME); \
|
||||
CheckAndSet(Attr::ATTRNAME); \
|
||||
return false; \
|
||||
}
|
||||
HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
|
||||
|
|
@ -294,6 +296,10 @@ protected:
|
|||
}
|
||||
|
||||
private:
|
||||
bool IsDuplicateAttr(Attr);
|
||||
bool HaveAttrConflict(Attr, Attr, Attr);
|
||||
bool IsConflictingAttr(Attr);
|
||||
|
||||
MaybeExpr bindName_; // from BIND(C, NAME="...")
|
||||
std::optional<SourceName> passName_; // from PASS(...)
|
||||
};
|
||||
|
|
@ -607,6 +613,7 @@ private:
|
|||
class InterfaceVisitor : public virtual ScopeHandler {
|
||||
public:
|
||||
bool Pre(const parser::InterfaceStmt &);
|
||||
void Post(const parser::InterfaceStmt &);
|
||||
void Post(const parser::EndInterfaceStmt &);
|
||||
bool Pre(const parser::GenericSpec &);
|
||||
bool Pre(const parser::ProcedureStmt &);
|
||||
|
|
@ -1548,26 +1555,69 @@ bool AttrsVisitor::SetBindNameOn(Symbol &symbol) {
|
|||
|
||||
void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
|
||||
CHECK(attrs_);
|
||||
attrs_->set(Attr::BIND_C);
|
||||
if (x.v) {
|
||||
bindName_ = EvaluateExpr(*x.v);
|
||||
if (CheckAndSet(Attr::BIND_C)) {
|
||||
if (x.v) {
|
||||
bindName_ = EvaluateExpr(*x.v);
|
||||
}
|
||||
}
|
||||
}
|
||||
bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
|
||||
CHECK(attrs_);
|
||||
attrs_->set(IntentSpecToAttr(x));
|
||||
CheckAndSet(IntentSpecToAttr(x));
|
||||
return false;
|
||||
}
|
||||
bool AttrsVisitor::Pre(const parser::Pass &x) {
|
||||
if (x.v) {
|
||||
passName_ = x.v->source;
|
||||
MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
|
||||
} else {
|
||||
attrs_->set(Attr::PASS);
|
||||
if (CheckAndSet(Attr::PASS)) {
|
||||
if (x.v) {
|
||||
passName_ = x.v->source;
|
||||
MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
// C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
|
||||
bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
|
||||
if (attrs_->test(attrName)) {
|
||||
Say(currStmtSource().value(),
|
||||
"Attribute '%s' cannot be used more than once"_en_US,
|
||||
AttrToString(attrName));
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
// See if attrName violates a constraint cause by a conflict. attr1 and attr2
|
||||
// name attributes that cannot be used on the same declaration
|
||||
bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
|
||||
if ((attrName == attr1 && attrs_->test(attr2)) ||
|
||||
(attrName == attr2 && attrs_->test(attr1))) {
|
||||
Say(currStmtSource().value(),
|
||||
"Attributes '%s' and '%s' conflict with each other"_err_en_US,
|
||||
AttrToString(attr1), AttrToString(attr2));
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
// C759, C1543
|
||||
bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
|
||||
return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||
|
||||
HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||
|
||||
HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
|
||||
HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) ||
|
||||
HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
|
||||
HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
|
||||
HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
|
||||
}
|
||||
bool AttrsVisitor::CheckAndSet(Attr attrName) {
|
||||
CHECK(attrs_);
|
||||
if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
|
||||
return false;
|
||||
}
|
||||
attrs_->set(attrName);
|
||||
return true;
|
||||
}
|
||||
|
||||
// DeclTypeSpecVisitor implementation
|
||||
|
||||
const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
|
||||
|
|
@ -1824,14 +1874,22 @@ void ArraySpecVisitor::PostAttrSpec() {
|
|||
// Save dimension/codimension from attrs so we can process array/coarray-spec
|
||||
// on the entity-decl
|
||||
if (!arraySpec_.empty()) {
|
||||
CHECK(attrArraySpec_.empty());
|
||||
attrArraySpec_ = arraySpec_;
|
||||
arraySpec_.clear();
|
||||
if (attrArraySpec_.empty()) {
|
||||
attrArraySpec_ = arraySpec_;
|
||||
arraySpec_.clear();
|
||||
} else {
|
||||
Say(currStmtSource().value(),
|
||||
"Attribute 'DIMENSION' cannot be used more than once"_err_en_US);
|
||||
}
|
||||
}
|
||||
if (!coarraySpec_.empty()) {
|
||||
CHECK(attrCoarraySpec_.empty());
|
||||
attrCoarraySpec_ = coarraySpec_;
|
||||
coarraySpec_.clear();
|
||||
if (attrCoarraySpec_.empty()) {
|
||||
attrCoarraySpec_ = coarraySpec_;
|
||||
coarraySpec_.clear();
|
||||
} else {
|
||||
Say(currStmtSource().value(),
|
||||
"Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -2395,9 +2453,11 @@ void ModuleVisitor::ApplyDefaultAccess() {
|
|||
bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
|
||||
bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};
|
||||
genericInfo_.emplace(/*isInterface*/ true, isAbstract);
|
||||
return true;
|
||||
return BeginAttrs();
|
||||
}
|
||||
|
||||
void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }
|
||||
|
||||
void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
|
||||
genericInfo_.pop();
|
||||
}
|
||||
|
|
@ -2624,9 +2684,15 @@ bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
|
|||
bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
|
||||
// Save this to process after UseStmt and ImplicitPart
|
||||
if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
|
||||
funcInfo_.parsedType = parsedType;
|
||||
funcInfo_.source = currStmtSource();
|
||||
return false;
|
||||
if (funcInfo_.parsedType) { // C1543
|
||||
Say(currStmtSource().value(),
|
||||
"FUNCTION prefix cannot specify the type more than once"_err_en_US);
|
||||
return false;
|
||||
} else {
|
||||
funcInfo_.parsedType = parsedType;
|
||||
funcInfo_.source = currStmtSource();
|
||||
return false;
|
||||
}
|
||||
} else {
|
||||
return true;
|
||||
}
|
||||
|
|
@ -3057,7 +3123,7 @@ bool DeclarationVisitor::Pre(const parser::AccessSpec &x) {
|
|||
"%s attribute may only appear in the specification part of a module"_err_en_US,
|
||||
EnumToString(attr));
|
||||
}
|
||||
attrs_->set(attr);
|
||||
CheckAndSet(attr);
|
||||
return false;
|
||||
}
|
||||
|
||||
|
|
@ -3522,7 +3588,12 @@ void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
|
|||
EndDecl();
|
||||
}
|
||||
bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
|
||||
derivedTypeInfo_.extends = &x.v;
|
||||
if (derivedTypeInfo_.extends) {
|
||||
Say(currStmtSource().value(),
|
||||
"Attribute 'EXTENDS' cannot be used more than once"_err_en_US);
|
||||
} else {
|
||||
derivedTypeInfo_.extends = &x.v;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -674,6 +674,22 @@ bool IsInitialized(const Symbol &symbol) {
|
|||
return false;
|
||||
}
|
||||
|
||||
bool HasIntrinsicTypeName(const Symbol &symbol) {
|
||||
std::string name{symbol.name().ToString()};
|
||||
if (name == "doubleprecision") {
|
||||
return true;
|
||||
} else if (name == "derived") {
|
||||
return false;
|
||||
} else {
|
||||
for (int i{0}; i != common::TypeCategory_enumSize; ++i) {
|
||||
if (name == parser::ToLowerCaseLetters(EnumToString(TypeCategory{i}))) {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
bool IsFinalizable(const Symbol &symbol) {
|
||||
if (const DeclTypeSpec * type{symbol.GetType()}) {
|
||||
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
|
||||
|
|
|
|||
|
|
@ -10,6 +10,8 @@
|
|||
! double-colon separator appears in the typedeclaration- stmt.
|
||||
! C727 The value of kind-param shall specify a representation method that
|
||||
! exists on the processor.
|
||||
! C728 The value of kind-param shall specify a representation method that
|
||||
! exists on the processor.
|
||||
!
|
||||
!ERROR: INTEGER(KIND=0) is not a supported type
|
||||
integer(kind=0) :: j0
|
||||
|
|
@ -53,6 +55,18 @@ logical(kind=-1) :: lm1
|
|||
logical(kind=3) :: l3
|
||||
!ERROR: LOGICAL(KIND=16) is not a supported type
|
||||
logical(kind=16) :: l16
|
||||
integer, parameter :: negOne = -1
|
||||
!ERROR: unsupported LOGICAL(KIND=0)
|
||||
logical :: lvar0 = .true._0
|
||||
logical :: lvar1 = .true._1
|
||||
logical :: lvar2 = .true._2
|
||||
!ERROR: unsupported LOGICAL(KIND=3)
|
||||
logical :: lvar3 = .true._3
|
||||
logical :: lvar4 = .true._4
|
||||
!ERROR: unsupported LOGICAL(KIND=5)
|
||||
logical :: lvar5 = .true._5
|
||||
!ERROR: unsupported LOGICAL(KIND=-1)
|
||||
logical :: lvar6 = .true._negOne
|
||||
character (len=99, kind=1) :: cvar1
|
||||
character (len=99, kind=2) :: cvar2
|
||||
character *4, cvar3
|
||||
|
|
|
|||
|
|
@ -0,0 +1,32 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
module m
|
||||
! C743 No component-attr-spec shall appear more than once in a
|
||||
! given component-def-stmt.
|
||||
!
|
||||
! R737 data-component-def-stmt ->
|
||||
! declaration-type-spec [[, component-attr-spec-list] ::]
|
||||
! component-decl-list
|
||||
! component-attr-spec values are:
|
||||
! PUBLIC, PRIVATE, ALLOCATABLE, CODIMENSION [*], CONTIGUOUS, DIMENSION(5),
|
||||
! POINTER
|
||||
|
||||
type :: derived
|
||||
!WARNING: Attribute 'PUBLIC' cannot be used more than once
|
||||
real, public, allocatable, public :: field1
|
||||
!WARNING: Attribute 'PRIVATE' cannot be used more than once
|
||||
real, private, allocatable, private :: field2
|
||||
!ERROR: Attributes 'PUBLIC' and 'PRIVATE' conflict with each other
|
||||
real, public, allocatable, private :: field3
|
||||
!WARNING: Attribute 'ALLOCATABLE' cannot be used more than once
|
||||
real, allocatable, public, allocatable :: field4
|
||||
!ERROR: Attribute 'CODIMENSION' cannot be used more than once
|
||||
real, public, codimension[:], allocatable, codimension[:] :: field5
|
||||
!WARNING: Attribute 'CONTIGUOUS' cannot be used more than once
|
||||
real, public, contiguous, pointer, contiguous, dimension(:) :: field6
|
||||
!ERROR: Attribute 'DIMENSION' cannot be used more than once
|
||||
real, dimension(5), public, dimension(5) :: field7
|
||||
!WARNING: Attribute 'POINTER' cannot be used more than once
|
||||
real, pointer, public, pointer :: field8
|
||||
end type derived
|
||||
|
||||
end module m
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
module m
|
||||
! C755 The same proc-component-attr-spec shall not appear more than once in a
|
||||
! given proc-component-def-stmt.
|
||||
! C759 PASS and NOPASS shall not both appear in the same
|
||||
! proc-component-attr-spec-list.
|
||||
!
|
||||
! R741 proc-component-def-stmt ->
|
||||
! PROCEDURE ( [proc-interface] ) , proc-component-attr-spec-list
|
||||
! :: proc-decl-list
|
||||
! proc-component-attr-spec values are:
|
||||
! PUBLIC, PRIVATE, NOPASS, PASS, POINTER
|
||||
|
||||
type :: procComponentType
|
||||
!WARNING: Attribute 'PUBLIC' cannot be used more than once
|
||||
procedure(publicProc), public, pointer, public :: publicField
|
||||
!WARNING: Attribute 'PRIVATE' cannot be used more than once
|
||||
procedure(privateProc), private, pointer, private :: privateField
|
||||
!WARNING: Attribute 'NOPASS' cannot be used more than once
|
||||
procedure(nopassProc), nopass, pointer, nopass :: noPassField
|
||||
!WARNING: Attribute 'PASS' cannot be used more than once
|
||||
procedure(passProc), pass, pointer, pass :: passField
|
||||
!ERROR: Attributes 'PASS' and 'NOPASS' conflict with each other
|
||||
procedure(passNopassProc), pass, pointer, nopass :: passNopassField
|
||||
!WARNING: Attribute 'POINTER' cannot be used more than once
|
||||
procedure(pointerProc), pointer, public, pointer :: pointerField
|
||||
contains
|
||||
procedure :: noPassProc
|
||||
procedure :: passProc
|
||||
procedure :: passNopassProc
|
||||
procedure :: publicProc
|
||||
procedure :: privateProc
|
||||
end type procComponentType
|
||||
|
||||
contains
|
||||
subroutine publicProc(arg)
|
||||
class(procComponentType) :: arg
|
||||
end
|
||||
subroutine privateProc(arg)
|
||||
class(procComponentType) :: arg
|
||||
end
|
||||
subroutine noPassProc(arg)
|
||||
class(procComponentType) :: arg
|
||||
end
|
||||
subroutine passProc(arg)
|
||||
class(procComponentType) :: arg
|
||||
end
|
||||
subroutine passNopassProc(arg)
|
||||
class(procComponentType) :: arg
|
||||
end
|
||||
subroutine pointerProc(arg)
|
||||
class(procComponentType) :: arg
|
||||
end
|
||||
end module m
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
module m
|
||||
!C778 The same binding-attr shall not appear more than once in a given
|
||||
!binding-attr-list.
|
||||
!
|
||||
!R749 type-bound-procedure-stmt
|
||||
! PROCEDURE [ [ ,binding-attr-list] :: ]type-bound-proc-decl-list
|
||||
! or PROCEDURE (interface-name),binding-attr-list::binding-name-list
|
||||
!
|
||||
!
|
||||
! binding-attr values are:
|
||||
! PUBLIC, PRIVATE, DEFERRED, NON_OVERRIDABLE, NOPASS, PASS [ (arg-name) ]
|
||||
!
|
||||
type, abstract :: boundProcType
|
||||
contains
|
||||
!WARNING: Attribute 'PUBLIC' cannot be used more than once
|
||||
procedure(subPublic), public, deferred, public :: publicBinding
|
||||
!WARNING: Attribute 'PRIVATE' cannot be used more than once
|
||||
procedure(subPrivate), private, deferred, private :: privateBinding
|
||||
!WARNING: Attribute 'DEFERRED' cannot be used more than once
|
||||
procedure(subDeferred), deferred, public, deferred :: deferredBinding
|
||||
!WARNING: Attribute 'NON_OVERRIDABLE' cannot be used more than once
|
||||
procedure, non_overridable, public, non_overridable :: subNon_overridable;
|
||||
!WARNING: Attribute 'NOPASS' cannot be used more than once
|
||||
procedure(subNopass), nopass, deferred, nopass :: nopassBinding
|
||||
!WARNING: Attribute 'PASS' cannot be used more than once
|
||||
procedure(subPass), pass, deferred, pass :: passBinding
|
||||
!ERROR: Attributes 'PASS' and 'NOPASS' conflict with each other
|
||||
procedure(subPassNopass), pass, deferred, nopass :: passNopassBinding
|
||||
end type boundProcType
|
||||
|
||||
contains
|
||||
subroutine subPublic(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subPublic
|
||||
|
||||
subroutine subPrivate(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subPrivate
|
||||
|
||||
subroutine subDeferred(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subDeferred
|
||||
|
||||
subroutine subNon_overridable(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subNon_overridable
|
||||
|
||||
subroutine subNopass(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subNopass
|
||||
|
||||
subroutine subPass(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subPass
|
||||
|
||||
subroutine subPassNopass(x)
|
||||
class(boundProcType), intent(in) :: x
|
||||
end subroutine subPassNopass
|
||||
|
||||
end module m
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
! C801 The same attr-spec shall not appear more than once in a given
|
||||
! type-declaration-stmt.
|
||||
!
|
||||
! R801 type-declaration-stmt ->
|
||||
! declaration-type-spec [[, attr-spec]... ::] entity-decl-list
|
||||
! attr-spec values are:
|
||||
! PUBLIC, PRIVATE, ALLOCATABLE, ASYNCHRONOUS, CODIMENSION, CONTIGUOUS,
|
||||
! DIMENSION (array-spec), EXTERNAL, INTENT (intent-spec), INTRINSIC,
|
||||
! BIND(C), OPTIONAL, PARAMETER, POINTER, PROTECTED, SAVE, TARGET, VALUE,
|
||||
! VOLATILE
|
||||
module m
|
||||
|
||||
!WARNING: Attribute 'PUBLIC' cannot be used more than once
|
||||
real, public, allocatable, public :: publicVar
|
||||
!WARNING: Attribute 'PRIVATE' cannot be used more than once
|
||||
real, private, allocatable, private :: privateVar
|
||||
!WARNING: Attribute 'ALLOCATABLE' cannot be used more than once
|
||||
real, allocatable, allocatable :: allocVar
|
||||
!WARNING: Attribute 'ASYNCHRONOUS' cannot be used more than once
|
||||
real, asynchronous, public, asynchronous :: asynchVar
|
||||
!ERROR: Attribute 'CODIMENSION' cannot be used more than once
|
||||
real, codimension[*], codimension[*] :: codimensionVar
|
||||
!WARNING: Attribute 'CONTIGUOUS' cannot be used more than once
|
||||
real, contiguous, pointer, contiguous :: contigVar(:)
|
||||
!ERROR: Attribute 'DIMENSION' cannot be used more than once
|
||||
real, dimension(5), dimension(5) :: arrayVar
|
||||
!WARNING: Attribute 'EXTERNAL' cannot be used more than once
|
||||
real, external, external :: externFunc
|
||||
!WARNING: Attribute 'INTRINSIC' cannot be used more than once
|
||||
real, intrinsic, bind(c), intrinsic :: cos
|
||||
!WARNING: Attribute 'BIND(C)' cannot be used more than once
|
||||
integer, bind(c), volatile, bind(c) :: bindVar
|
||||
!WARNING: Attribute 'PARAMETER' cannot be used more than once
|
||||
real, parameter, parameter :: realConst = 4.3
|
||||
!WARNING: Attribute 'POINTER' cannot be used more than once
|
||||
real, pointer, pointer :: realPtr
|
||||
!WARNING: Attribute 'PROTECTED' cannot be used more than once
|
||||
real, protected, protected :: realProt
|
||||
!WARNING: Attribute 'SAVE' cannot be used more than once
|
||||
real, save, save :: saveVar
|
||||
!WARNING: Attribute 'TARGET' cannot be used more than once
|
||||
real, target, target :: targetVar
|
||||
!WARNING: Attribute 'VOLATILE' cannot be used more than once
|
||||
real, volatile, volatile :: volatileVar
|
||||
|
||||
contains
|
||||
subroutine testTypeDecl(arg1, arg2, arg3, arg4, arg5, arg6)
|
||||
!WARNING: Attribute 'INTENT(IN)' cannot be used more than once
|
||||
real, intent(in), intent(in) :: arg1
|
||||
!WARNING: Attribute 'INTENT(OUT)' cannot be used more than once
|
||||
real, intent(out), intent(out) :: arg2
|
||||
!WARNING: Attribute 'INTENT(INOUT)' cannot be used more than once
|
||||
real, intent(inout), intent(inout) :: arg3
|
||||
!WARNING: Attribute 'OPTIONAL' cannot be used more than once
|
||||
integer, optional, intent(in), optional :: arg4
|
||||
!WARNING: Attribute 'VALUE' cannot be used more than once
|
||||
integer, value, intent(in), value :: arg5
|
||||
!ERROR: Attributes 'INTENT(IN)' and 'INTENT(INOUT)' conflict with each other
|
||||
integer, intent(in), pointer, intent(inout) :: arg6
|
||||
|
||||
arg2 =3.5
|
||||
end subroutine testTypeDecl
|
||||
end module m
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
! C815 An entity shall not be explicitly given any attribute more than once in
|
||||
! a scoping unit.
|
||||
!
|
||||
! R1512 procedure-declaration-stmt ->
|
||||
! PROCEDURE ( [proc-interface] ) [[, proc-attr-spec]... ::]
|
||||
! proc-decl-list
|
||||
! proc-attr-spec values are:
|
||||
! PUBLIC, PRIVATE, BIND(C), INTENT (intent-spec), OPTIONAL, POINTER,
|
||||
! PROTECTED, SAVE
|
||||
module m
|
||||
abstract interface
|
||||
real function procFunc()
|
||||
end function procFunc
|
||||
end interface
|
||||
|
||||
!WARNING: Attribute 'PUBLIC' cannot be used more than once
|
||||
procedure(procFunc), public, pointer, public :: proc1
|
||||
!WARNING: Attribute 'PRIVATE' cannot be used more than once
|
||||
procedure(procFunc), private, pointer, private :: proc2
|
||||
!WARNING: Attribute 'BIND(C)' cannot be used more than once
|
||||
procedure(procFunc), bind(c), pointer, bind(c) :: proc3
|
||||
!WARNING: Attribute 'PROTECTED' cannot be used more than once
|
||||
procedure(procFunc), protected, pointer, protected :: proc4
|
||||
|
||||
contains
|
||||
|
||||
subroutine testProcDecl(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)
|
||||
!WARNING: Attribute 'INTENT(IN)' cannot be used more than once
|
||||
procedure(procFunc), intent(in), pointer, intent(in) :: arg4
|
||||
!WARNING: Attribute 'INTENT(OUT)' cannot be used more than once
|
||||
procedure(procFunc), intent(out), pointer, intent(out) :: arg5
|
||||
!WARNING: Attribute 'INTENT(INOUT)' cannot be used more than once
|
||||
procedure(procFunc), intent(inout), pointer, intent(inout) :: arg6
|
||||
!ERROR: Attributes 'INTENT(INOUT)' and 'INTENT(OUT)' conflict with each other
|
||||
procedure(procFunc), intent(inout), pointer, intent(out) :: arg7
|
||||
!ERROR: Attributes 'INTENT(INOUT)' and 'INTENT(OUT)' conflict with each other
|
||||
procedure(procFunc), intent(out), pointer, intent(inout) :: arg8
|
||||
!WARNING: Attribute 'OPTIONAL' cannot be used more than once
|
||||
procedure(procFunc), optional, pointer, optional :: arg9
|
||||
!WARNING: Attribute 'POINTER' cannot be used more than once
|
||||
procedure(procFunc), pointer, optional, pointer :: arg10
|
||||
!WARNING: Attribute 'SAVE' cannot be used more than once
|
||||
procedure(procFunc), save, pointer, save :: localProc
|
||||
end subroutine testProcDecl
|
||||
|
||||
end module m
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
module m
|
||||
|
||||
! For C1543
|
||||
interface intFace
|
||||
!WARNING: Attribute 'MODULE' cannot be used more than once
|
||||
module pure module real function moduleFunc()
|
||||
end function moduleFunc
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
! C1543 A prefix shall contain at most one of each prefix-spec.
|
||||
!
|
||||
! R1535 subroutine-stmt is
|
||||
! [prefix] SUBROUTINE subroutine-name [ ( [dummy-arg-list] )
|
||||
! [proc-language-binding-spec] ]
|
||||
!
|
||||
! R1526 prefix is
|
||||
! prefix-spec[prefix-spec]...
|
||||
!
|
||||
! prefix-spec values are:
|
||||
! declaration-type-spec, ELEMENTAL, IMPURE, MODULE, NON_RECURSIVE,
|
||||
! PURE, RECURSIVE
|
||||
|
||||
!ERROR: FUNCTION prefix cannot specify the type more than once
|
||||
real pure real function realFunc()
|
||||
end function realFunc
|
||||
|
||||
!WARNING: Attribute 'ELEMENTAL' cannot be used more than once
|
||||
elemental real elemental function elementalFunc()
|
||||
end function elementalFunc
|
||||
|
||||
!WARNING: Attribute 'IMPURE' cannot be used more than once
|
||||
impure real impure function impureFunc()
|
||||
end function impureFunc
|
||||
|
||||
!WARNING: Attribute 'PURE' cannot be used more than once
|
||||
pure real pure function pureFunc()
|
||||
end function pureFunc
|
||||
|
||||
!ERROR: Attributes 'PURE' and 'IMPURE' conflict with each other
|
||||
impure real pure function impurePureFunc()
|
||||
end function impurePureFunc
|
||||
|
||||
!WARNING: Attribute 'RECURSIVE' cannot be used more than once
|
||||
recursive real recursive function recursiveFunc()
|
||||
end function recursiveFunc
|
||||
|
||||
!WARNING: Attribute 'NON_RECURSIVE' cannot be used more than once
|
||||
non_recursive real non_recursive function non_recursiveFunc()
|
||||
end function non_recursiveFunc
|
||||
|
||||
!ERROR: Attributes 'RECURSIVE' and 'NON_RECURSIVE' conflict with each other
|
||||
non_recursive real recursive function non_recursiveRecursiveFunc()
|
||||
end function non_recursiveRecursiveFunc
|
||||
end module m
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
! C729 A derived type type-name shall not be DOUBLEPRECISION or the same as
|
||||
! the name of any intrinsic type defined in this document.
|
||||
subroutine s()
|
||||
! This one's OK
|
||||
type derived
|
||||
end type
|
||||
!ERROR: A derived type name cannot be the name of an intrinsic type
|
||||
type integer
|
||||
end type
|
||||
!ERROR: A derived type name cannot be the name of an intrinsic type
|
||||
type real
|
||||
end type
|
||||
!ERROR: A derived type name cannot be the name of an intrinsic type
|
||||
type doubleprecision
|
||||
end type
|
||||
!ERROR: A derived type name cannot be the name of an intrinsic type
|
||||
type complex
|
||||
end type
|
||||
!ERROR: A derived type name cannot be the name of an intrinsic type
|
||||
type character
|
||||
end type
|
||||
!ERROR: A derived type name cannot be the name of an intrinsic type
|
||||
type logical
|
||||
end type
|
||||
end subroutine s
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
module m
|
||||
! C730 The same type-attr-spec shall not appear more than once in a given
|
||||
! derived-type-stmt.
|
||||
!
|
||||
! R727 derived-type-stmt ->
|
||||
! TYPE [[, type-attr-spec-list] ::] type-name [( type-param-name-list )]
|
||||
! type-attr-spec values are:
|
||||
! ABSTRACT, PUBLIC, PRIVATE, BIND(C), EXTENDS(parent-type-name)
|
||||
!WARNING: Attribute 'ABSTRACT' cannot be used more than once
|
||||
type, abstract, public, abstract :: derived1
|
||||
end type derived1
|
||||
|
||||
!WARNING: Attribute 'PUBLIC' cannot be used more than once
|
||||
type, public, abstract, public :: derived2
|
||||
end type derived2
|
||||
|
||||
!WARNING: Attribute 'PRIVATE' cannot be used more than once
|
||||
type, private, abstract, private :: derived3
|
||||
end type derived3
|
||||
|
||||
!ERROR: Attributes 'PUBLIC' and 'PRIVATE' conflict with each other
|
||||
type, public, abstract, private :: derived4
|
||||
end type derived4
|
||||
|
||||
!WARNING: Attribute 'BIND(C)' cannot be used more than once
|
||||
type, bind(c), public, bind(c) :: derived5
|
||||
end type derived5
|
||||
|
||||
type, public :: derived6
|
||||
end type derived6
|
||||
|
||||
!ERROR: Attribute 'EXTENDS' cannot be used more than once
|
||||
type, extends(derived6), public, extends(derived6) :: derived7
|
||||
end type derived7
|
||||
|
||||
end module m
|
||||
Loading…
Reference in New Issue