diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp index da02b4fbe47f..0237ced6b211 100644 --- a/lib/Semantics/check-declarations.cpp +++ b/lib/Semantics/check-declarations.cpp @@ -384,15 +384,24 @@ void CheckHelper::CheckObjectEntity( CheckAssumedTypeEntity(symbol, details); symbolBeingChecked_ = nullptr; if (!details.coshape().empty()) { + bool isDeferredShape{details.coshape().IsDeferredShape()}; if (IsAllocatable(symbol)) { - if (!details.coshape().IsDeferredShape()) { // C827 - messages_.Say( - "ALLOCATABLE coarray must have a deferred coshape"_err_en_US); + if (!isDeferredShape) { // C827 + messages_.Say("'%s' is an ALLOCATABLE coarray must have a deferred" + " coshape"_err_en_US, + symbol.name()); } + } else if (symbol.owner().IsDerivedType()) { // C746 + std::string deferredMsg{ + isDeferredShape ? "" : " and have a deferred coshape"}; + messages_.Say("Component '%s' is a coarray and must have the ALLOCATABLE" + " attribute%s"_err_en_US, + symbol.name(), deferredMsg); } else { if (!details.coshape().IsAssumedSize()) { // C828 - messages_.Say( - "Non-ALLOCATABLE coarray must have an explicit coshape"_err_en_US); + messages_.Say("Component '%s' is a non-ALLOCATABLE coarray must have" + " an explicit coshape"_err_en_US, + symbol.name()); } } } @@ -465,7 +474,7 @@ void CheckHelper::CheckObjectEntity( symbol.name()); } } -} +} // namespace Fortran::semantics // The six different kinds of array-specs: // array-spec -> explicit-shape-list | deferred-shape-list diff --git a/lib/Semantics/resolve-names.cpp b/lib/Semantics/resolve-names.cpp index 7828d6906cf6..6cbe06183d3e 100644 --- a/lib/Semantics/resolve-names.cpp +++ b/lib/Semantics/resolve-names.cpp @@ -3680,7 +3680,7 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { if (symbol->has() && !paramNames.count(name)) { SayDerivedType(name, "'%s' is not a type parameter of this derived type"_err_en_US, - currScope()); // C742 + currScope()); // C741 } } Walk(std::get>>(x.t)); @@ -3821,14 +3821,46 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { attrs.set(Attr::PRIVATE); } - if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { - if (const auto *declType{GetDeclTypeSpec()}) { - if (const auto *derived{declType->AsDerived()}) { + if (const auto *declType{GetDeclTypeSpec()}) { + if (const auto *derived{declType->AsDerived()}) { + if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744 Say("Recursive use of the derived type requires " "POINTER or ALLOCATABLE"_err_en_US); } } + if (!coarraySpec().empty()) { // C747 + if (IsTeamType(derived)) { + Say("A coarray component may not be of type TEAM_TYPE from " + "ISO_FORTRAN_ENV"_err_en_US); + } else { + if (IsIsoCType(derived)) { + Say("A coarray component may not be of type C_PTR or C_FUNPTR from " + "ISO_C_BINDING when an allocatable object is a " + "coarray"_err_en_US); + } + } + } + if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748 + std::string ultimateName{it.BuildResultDesignatorName()}; + if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { + evaluate::AttachDeclaration( + Say(name.source, + "A component with a POINTER or ALLOCATABLE attribute may not " + "be of a type with a coarray ultimate component (named " + "'%s')"_err_en_US, + ultimateName), + derived->typeSymbol()); + } + if (!arraySpec().empty() || !coarraySpec().empty()) { + evaluate::AttachDeclaration( + Say(name.source, + "An array or coarray component may not be of a type with a " + "coarray ultimate component (named '%s')"_err_en_US, + ultimateName), + derived->typeSymbol()); + } + } } } if (OkToAddComponent(name)) { @@ -4742,7 +4774,7 @@ Symbol *DeclarationVisitor::MakeTypeSymbol( const SourceName &name, Details &&details) { Scope &derivedType{currScope()}; CHECK(derivedType.IsDerivedType()); - if (auto *symbol{FindInScope(derivedType, name)}) { + if (auto *symbol{FindInScope(derivedType, name)}) { // C742 Say2(name, "Type parameter, component, or procedure binding '%s'" " already defined in this type"_err_en_US, diff --git a/test/Semantics/allocate11.f90 b/test/Semantics/allocate11.f90 index 594bd1ded385..89f8cd870b69 100644 --- a/test/Semantics/allocate11.f90 +++ b/test/Semantics/allocate11.f90 @@ -5,19 +5,6 @@ ! Rules I should know when working with coarrays and derived type: -! C736: If EXTENDS appears and the type being defined has a coarray ultimate -! component, its parent type shall have a coarray ultimate component. - -! C746: (R737) If a coarray-spec appears, it shall be a deferred-coshape-spec-list -! and the component shall have the ALLOCATABLE attribute. - -! C747: If a coarray-spec appears, the component shall not be of type C_PTR or -! C_FUNPTR from the intrinsic module ISO_C_BINDING (18.2), or of type TEAM_TYPE from the -! intrinsic module ISO_FORTRAN_ENV (16.10.2). - -! C748: A data component whose type has a coarray ultimate component shall be a -! nonpointer nonallocatable scalar and shall not be a coarray. - ! 7.5.4.3 Coarray components ! 7.5.6 Final subroutines: C786 @@ -38,7 +25,6 @@ subroutine C937(var) type B type(A) y - type(B), pointer :: forward real :: u end type @@ -47,7 +33,7 @@ subroutine C937(var) end type type D - type(A), pointer :: potential + type(A) :: potential end type @@ -66,9 +52,6 @@ subroutine C937(var) ! Also, as per C826 or C852, var can only be an allocatable, not a pointer - ! OK, x is not an ultimate component - allocate(D:: var) - !ERROR: Type-spec in ALLOCATE must not specify a type with a coarray ultimate component allocate(A:: var) !ERROR: Type-spec in ALLOCATE must not specify a type with a coarray ultimate component diff --git a/test/Semantics/call12.f90 b/test/Semantics/call12.f90 index e25a2608c441..65da46b067d6 100644 --- a/test/Semantics/call12.f90 +++ b/test/Semantics/call12.f90 @@ -15,7 +15,7 @@ module m real, pointer :: p end type type :: hasCoarray - real :: co[*] + real, allocatable :: co[:] end type contains pure function test(ptr, in, hpd) diff --git a/test/Semantics/call14.f90 b/test/Semantics/call14.f90 index b874e6b00912..ee5086511de3 100644 --- a/test/Semantics/call14.f90 +++ b/test/Semantics/call14.f90 @@ -3,7 +3,7 @@ module m type :: hasCoarray - real :: coarray[*] + real, allocatable :: coarray[:] end type contains !ERROR: VALUE attribute may apply only to a dummy data object diff --git a/test/Semantics/misc-declarations.f90 b/test/Semantics/misc-declarations.f90 index 7680eed793bc..0e0a55b27a45 100644 --- a/test/Semantics/misc-declarations.f90 +++ b/test/Semantics/misc-declarations.f90 @@ -4,12 +4,12 @@ ! - 8.5.19 constraints on the VOLATILE attribute module m - !ERROR: ALLOCATABLE coarray must have a deferred coshape + !ERROR: 'mustbedeferred' is an ALLOCATABLE coarray must have a deferred coshape real, allocatable :: mustBeDeferred[*] ! C827 - !ERROR: Non-ALLOCATABLE coarray must have an explicit coshape + !ERROR: Component 'mustbeexplicit' is a non-ALLOCATABLE coarray must have an explicit coshape real :: mustBeExplicit[:] ! C828 type :: hasCoarray - real :: coarray[*] + real, allocatable :: coarray[:] end type real :: coarray[*] type(hasCoarray) :: coarrayComponent diff --git a/test/Semantics/modfile24.f90 b/test/Semantics/modfile24.f90 index ec446f9e8d3c..45f6c0545627 100644 --- a/test/Semantics/modfile24.f90 +++ b/test/Semantics/modfile24.f90 @@ -36,8 +36,8 @@ module m2 ! coarray-spec in components and with non-constants bounds module m3 type t - real :: c[1:10,1:*] - complex, codimension[5,*] :: d + real, allocatable :: c[:,:] + complex, allocatable, codimension[:,:] :: d end type real, allocatable :: e[:,:,:] contains @@ -50,8 +50,8 @@ subroutine s(a, b, n) !Expect: m3.mod !module m3 ! type::t -! real(4)::c[1_8:10_8,1_8:*] -! complex(4)::d[1_8:5_8,1_8:*] +! real(4),allocatable::c[:,:] +! complex(4),allocatable::d[:,:] ! end type ! real(4),allocatable::e[:,:,:] !contains diff --git a/test/Semantics/resolve33.f90 b/test/Semantics/resolve33.f90 index 176404b9db63..ac6f7c7ddfaf 100644 --- a/test/Semantics/resolve33.f90 +++ b/test/Semantics/resolve33.f90 @@ -2,7 +2,13 @@ ! Derived type parameters ! C731 The same type-param-name shall not appear more than once in a given ! derived-type-stmt. - +! C741 A type-param-name in a type-param-def-stmt in a derived-type-def shall +! be one of the type-paramnames in the derived-type-stmt of that +! derived-type-def. +! C742 Each type-param-name in the derived-type-stmt in a derived-type-def +! shall appear exactly once as a type-param-name in a type-param-def-stmt +! in that derived-type-def . + module m !ERROR: Duplicate type parameter name: 'a' type t1(a, b, a) diff --git a/test/Semantics/resolve44.f90 b/test/Semantics/resolve44.f90 index 2d8b70178753..41ab06ffb6c6 100644 --- a/test/Semantics/resolve44.f90 +++ b/test/Semantics/resolve44.f90 @@ -1,5 +1,8 @@ ! RUN: %B/test/Semantics/test_errors.sh %s %flang %t ! Error tests for recursive use of derived types. +! C744 If neither the POINTER nor the ALLOCATABLE attribute is specified, the +! declaration-type-spec in the component-def-stmt shall specify an intrinsic +! type or a previously defined derived type. program main type :: recursive1 diff --git a/test/Semantics/resolve88.f90 b/test/Semantics/resolve88.f90 new file mode 100644 index 000000000000..62c78c8040a7 --- /dev/null +++ b/test/Semantics/resolve88.f90 @@ -0,0 +1,75 @@ +! RUN: %B/test/Semantics/test_errors.sh %s %flang %t +! C746, C747, and C748 +module m + use ISO_FORTRAN_ENV + use ISO_C_BINDING + + ! C746 If a coarray-spec appears, it shall be a deferred-coshape-spec-list and + ! the component shall have the ALLOCATABLE attribute. + + type testCoArrayType + real, allocatable, codimension[:] :: allocatableField + !ERROR: Component 'deferredfield' is a coarray and must have the ALLOCATABLE attribute + real, codimension[:] :: deferredField + !ERROR: 'pointerfield' may not have the POINTER attribute because it is a coarray + !ERROR: Component 'pointerfield' is a coarray and must have the ALLOCATABLE attribute + real, pointer, codimension[:] :: pointerField + !ERROR: Component 'realfield' is a coarray and must have the ALLOCATABLE attribute and have a deferred coshape + real, codimension[*] :: realField + !ERROR: 'realfield2' is an ALLOCATABLE coarray must have a deferred coshape + real, allocatable, codimension[*] :: realField2 + end type testCoArrayType + + ! C747 If a coarray-spec appears, the component shall not be of type C_PTR or + ! C_FUNPTR from the intrinsic module ISO_C_BINDING (18.2), or of type + ! TEAM_TYPE from the intrinsic module ISO_FORTRAN_ENV (16.10.2). + + type goodCoarrayType + real, allocatable, codimension[:] :: field + end type goodCoarrayType + + type goodTeam_typeCoarrayType + type(team_type), allocatable :: field + end type goodTeam_typeCoarrayType + + type goodC_ptrCoarrayType + type(c_ptr), allocatable :: field + end type goodC_ptrCoarrayType + + type goodC_funptrCoarrayType + type(c_funptr), allocatable :: field + end type goodC_funptrCoarrayType + + type team_typeCoarrayType + !ERROR: A coarray component may not be of type TEAM_TYPE from ISO_FORTRAN_ENV + type(team_type), allocatable, codimension[:] :: field + end type team_typeCoarrayType + + type c_ptrCoarrayType + !ERROR: A coarray component may not be of type C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray + type(c_ptr), allocatable, codimension[:] :: field + end type c_ptrCoarrayType + + type c_funptrCoarrayType + !ERROR: A coarray component may not be of type C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray + type(c_funptr), allocatable, codimension[:] :: field + end type c_funptrCoarrayType + +! C748 A data component whose type has a coarray ultimate component shall be a +! nonpointer nonallocatable scalar and shall not be a coarray. + + type coarrayType + real, allocatable, codimension[:] :: goodCoarrayField + end type coarrayType + + type testType + type(coarrayType) :: goodField + !ERROR: A component with a POINTER or ALLOCATABLE attribute may not be of a type with a coarray ultimate component (named '%goodcoarrayfield') + type(coarrayType), pointer :: pointerField + !ERROR: A component with a POINTER or ALLOCATABLE attribute may not be of a type with a coarray ultimate component (named '%goodcoarrayfield') + type(coarrayType), allocatable :: allocatableField + !ERROR: An array or coarray component may not be of a type with a coarray ultimate component (named '%goodcoarrayfield') + type(coarrayType), dimension(3) :: arrayField + end type testType + +end module m