From 8003424cb6e0e4278a5f6d632365368df8a2e3fc Mon Sep 17 00:00:00 2001 From: Pete Steinfeld Date: Fri, 3 Apr 2020 19:13:35 -0700 Subject: [PATCH 1/3] Check for constrains C741 through C749 Most of these checks were already implemented and I just added references to them to the code and tests. I implemented the check for C747 to not allow coarray components in derived types that are of type C_PTR, C_FUNPTR, or type TEAM_TYPE. I implemented the check for C748 that requires a data component whose type has a coarray ultimate component to be a nonpointer, nonallocatable scalar and not be a coarray. I also fixed some unrelated tests that got new errors when I implemented these checks. --- lib/Semantics/check-declarations.cpp | 8 ++- lib/Semantics/resolve-names.cpp | 32 ++++++++++-- test/Semantics/allocate11.f90 | 19 +------- test/Semantics/call12.f90 | 2 +- test/Semantics/call14.f90 | 2 +- test/Semantics/misc-declarations.f90 | 2 +- test/Semantics/modfile24.f90 | 8 +-- test/Semantics/resolve33.f90 | 8 ++- test/Semantics/resolve44.f90 | 3 ++ test/Semantics/resolve88.f90 | 73 ++++++++++++++++++++++++++++ 10 files changed, 124 insertions(+), 33 deletions(-) create mode 100644 test/Semantics/resolve88.f90 diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp index da02b4fbe47f..54d09f92bb5b 100644 --- a/lib/Semantics/check-declarations.cpp +++ b/lib/Semantics/check-declarations.cpp @@ -385,12 +385,16 @@ void CheckHelper::CheckObjectEntity( symbolBeingChecked_ = nullptr; if (!details.coshape().empty()) { if (IsAllocatable(symbol)) { - if (!details.coshape().IsDeferredShape()) { // C827 + if (!details.coshape().IsDeferredShape()) { // C746, C827 messages_.Say( "ALLOCATABLE coarray must have a deferred coshape"_err_en_US); } + } else if (symbol.owner().IsDerivedType()) { // C746 + messages_.Say( + "Coarray components must be ALLOCATABLE and have a deferred " + "coshape"_err_en_US); } else { - if (!details.coshape().IsAssumedSize()) { // C828 + if (!details.coshape().IsAssumedSize()) { // C746, C828 messages_.Say( "Non-ALLOCATABLE coarray must have an explicit coshape"_err_en_US); } diff --git a/lib/Semantics/resolve-names.cpp b/lib/Semantics/resolve-names.cpp index 7828d6906cf6..588d64876fe1 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,36 @@ 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 C_PTR or C_FUNPTR from " + "ISO_C_BINDING when an allocatable object is a " + "coarray"_err_en_US); + } + } + } + if (FindCoarrayUltimateComponent(*derived)) { // C748 + if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { + Say("A component whose type has a coarray ultimate component " + "cannot be a POINTER or ALLOCATABLE"_err_en_US); + } + if (!arraySpec().empty() || !coarraySpec().empty()) { + Say("A component whose type has a coarray ultimate component " + "cannot be an array or corray"_err_en_US); + } + } } } if (OkToAddComponent(name)) { @@ -4742,7 +4764,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..38ca6804c490 100644 --- a/test/Semantics/misc-declarations.f90 +++ b/test/Semantics/misc-declarations.f90 @@ -9,7 +9,7 @@ module m !ERROR: 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..854f99709fda --- /dev/null +++ b/test/Semantics/resolve88.f90 @@ -0,0 +1,73 @@ +! 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: Coarray components must be ALLOCATABLE and have a deferred coshape + real, codimension[:] :: deferredField + !ERROR: 'pointerfield' may not have the POINTER attribute because it is a coarray + !ERROR: Coarray components must be ALLOCATABLE and have a deferred coshape + real, pointer, codimension[:] :: pointerField + !ERROR: Coarray components must be ALLOCATABLE and have a deferred coshape + real, codimension[*] :: realField + 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 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 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 whose type has a coarray ultimate component cannot be a POINTER or ALLOCATABLE + type(coarrayType), pointer :: pointerField + !ERROR: A component whose type has a coarray ultimate component cannot be a POINTER or ALLOCATABLE + type(coarrayType), allocatable :: allocatableField + !ERROR: A component whose type has a coarray ultimate component cannot be an array or corray + type(coarrayType), dimension(3) :: arrayField + end type testType + +end module m From b1df146b5a3bb5c39c35cebe95e8eac6f0c7ebad Mon Sep 17 00:00:00 2001 From: Pete Steinfeld Date: Tue, 7 Apr 2020 15:39:54 -0700 Subject: [PATCH 2/3] Responses to pull request comments I redid the error messages for violations of C746 to be more consistent and customized them so that we don't complain unnecessarily about deferred coshapes. I removed some spurious references to C746. I fixed the error message for coarray components of type C_PTR or C_FUNPTR. I added an attachment to the messages relating to ultimate components to point to the relevant declarations. I fixed the tests to match the message changes in the code and added another test for components that are allocatable coarrays that do not have a deferred coshape. --- lib/Semantics/check-declarations.cpp | 25 +++++++++++++++---------- lib/Semantics/resolve-names.cpp | 13 +++++++++---- test/Semantics/misc-declarations.f90 | 4 ++-- test/Semantics/resolve88.f90 | 18 ++++++++++-------- 4 files changed, 36 insertions(+), 24 deletions(-) diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp index 54d09f92bb5b..0237ced6b211 100644 --- a/lib/Semantics/check-declarations.cpp +++ b/lib/Semantics/check-declarations.cpp @@ -384,19 +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()) { // C746, 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 - messages_.Say( - "Coarray components must be ALLOCATABLE and have a deferred " - "coshape"_err_en_US); + 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()) { // C746, C828 - messages_.Say( - "Non-ALLOCATABLE coarray must have an explicit coshape"_err_en_US); + if (!details.coshape().IsAssumedSize()) { // C828 + messages_.Say("Component '%s' is a non-ALLOCATABLE coarray must have" + " an explicit coshape"_err_en_US, + symbol.name()); } } } @@ -469,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 588d64876fe1..84eeff11af50 100644 --- a/lib/Semantics/resolve-names.cpp +++ b/lib/Semantics/resolve-names.cpp @@ -3835,20 +3835,25 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { "ISO_FORTRAN_ENV"_err_en_US); } else { if (IsIsoCType(derived)) { - Say("A coarray component may not be of C_PTR or C_FUNPTR from " + 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 (FindCoarrayUltimateComponent(*derived)) { // C748 + if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748 + Message declMsg{Say(it->name(), + "Type '%s' has coarray ultimate component '%s' declared here"_en_US, + declType->AsFortran(), it.BuildResultDesignatorName())}; if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { Say("A component whose type has a coarray ultimate component " - "cannot be a POINTER or ALLOCATABLE"_err_en_US); + "may not be a POINTER or ALLOCATABLE"_err_en_US) + .Attach(declMsg); } if (!arraySpec().empty() || !coarraySpec().empty()) { Say("A component whose type has a coarray ultimate component " - "cannot be an array or corray"_err_en_US); + "may not be an array or corray"_err_en_US) + .Attach(declMsg); } } } diff --git a/test/Semantics/misc-declarations.f90 b/test/Semantics/misc-declarations.f90 index 38ca6804c490..0e0a55b27a45 100644 --- a/test/Semantics/misc-declarations.f90 +++ b/test/Semantics/misc-declarations.f90 @@ -4,9 +4,9 @@ ! - 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, allocatable :: coarray[:] diff --git a/test/Semantics/resolve88.f90 b/test/Semantics/resolve88.f90 index 854f99709fda..ed20857044af 100644 --- a/test/Semantics/resolve88.f90 +++ b/test/Semantics/resolve88.f90 @@ -9,13 +9,15 @@ module m type testCoArrayType real, allocatable, codimension[:] :: allocatableField - !ERROR: Coarray components must be ALLOCATABLE and have a deferred coshape + !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: Coarray components must be ALLOCATABLE and have a deferred coshape + !ERROR: Component 'pointerfield' is a coarray and must have the ALLOCATABLE attribute real, pointer, codimension[:] :: pointerField - !ERROR: Coarray components must be ALLOCATABLE and have a deferred coshape + !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 @@ -44,12 +46,12 @@ module m end type team_typeCoarrayType type c_ptrCoarrayType - !ERROR: A coarray component may not be of C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray + !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 C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray + !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 @@ -62,11 +64,11 @@ module m type testType type(coarrayType) :: goodField - !ERROR: A component whose type has a coarray ultimate component cannot be a POINTER or ALLOCATABLE + !ERROR: A component whose type has a coarray ultimate component may not be a POINTER or ALLOCATABLE type(coarrayType), pointer :: pointerField - !ERROR: A component whose type has a coarray ultimate component cannot be a POINTER or ALLOCATABLE + !ERROR: A component whose type has a coarray ultimate component may not be a POINTER or ALLOCATABLE type(coarrayType), allocatable :: allocatableField - !ERROR: A component whose type has a coarray ultimate component cannot be an array or corray + !ERROR: A component whose type has a coarray ultimate component may not be an array or corray type(coarrayType), dimension(3) :: arrayField end type testType From 57b82a96ea1d583164fcdfeb547c65c8a0bf35c6 Mon Sep 17 00:00:00 2001 From: Pete Steinfeld Date: Wed, 8 Apr 2020 13:35:54 -0700 Subject: [PATCH 3/3] I redid the code that produced error messages for components with coarray ultimate components to use the function AttachDeclaration() to output the declaration of the derived type that contains the associated coarray ultimate component. --- lib/Semantics/resolve-names.cpp | 23 ++++++++++++++--------- test/Semantics/resolve88.f90 | 6 +++--- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/lib/Semantics/resolve-names.cpp b/lib/Semantics/resolve-names.cpp index 84eeff11af50..6cbe06183d3e 100644 --- a/lib/Semantics/resolve-names.cpp +++ b/lib/Semantics/resolve-names.cpp @@ -3842,18 +3842,23 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { } } if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748 - Message declMsg{Say(it->name(), - "Type '%s' has coarray ultimate component '%s' declared here"_en_US, - declType->AsFortran(), it.BuildResultDesignatorName())}; + std::string ultimateName{it.BuildResultDesignatorName()}; if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { - Say("A component whose type has a coarray ultimate component " - "may not be a POINTER or ALLOCATABLE"_err_en_US) - .Attach(declMsg); + 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()) { - Say("A component whose type has a coarray ultimate component " - "may not be an array or corray"_err_en_US) - .Attach(declMsg); + 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()); } } } diff --git a/test/Semantics/resolve88.f90 b/test/Semantics/resolve88.f90 index ed20857044af..62c78c8040a7 100644 --- a/test/Semantics/resolve88.f90 +++ b/test/Semantics/resolve88.f90 @@ -64,11 +64,11 @@ module m type testType type(coarrayType) :: goodField - !ERROR: A component whose type has a coarray ultimate component may not be a POINTER or ALLOCATABLE + !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 whose type has a coarray ultimate component may not be a POINTER or ALLOCATABLE + !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: A component whose type has a coarray ultimate component may not be an array or corray + !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