// 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> {
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,
}
}
}
+ if (HasIntrinsicTypeName(symbol)) { // C729
+ messages_.Say("A derived type name cannot be the name of an intrinsic"
+ " type"_err_en_US);
+ }
}
void CheckHelper::CheckGeneric(
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;
}
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,
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()));
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)
}
private:
+ bool IsDuplicateAttr(Attr);
+ bool HaveAttrConflict(Attr, Attr, Attr);
+ bool IsConflictingAttr(Attr);
+
MaybeExpr bindName_; // from BIND(C, NAME="...")
std::optional<SourceName> passName_; // from PASS(...)
};
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 &);
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() {
// 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);
+ }
}
}
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();
}
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;
}
"%s attribute may only appear in the specification part of a module"_err_en_US,
EnumToString(attr));
}
- attrs_->set(attr);
+ CheckAndSet(attr);
return false;
}
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;
}
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()}) {
! 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
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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
projects / platform / upstream / llvm.git / commitdiff