Check for constrains C741 through C749

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

lib/Semantics/resolve-names.cpp

@@ -3680,7 +3680,7 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
     if (symbol->has<TypeParamDetails>() && !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<std::list<parser::Statement<parser::PrivateOrSequence>>>(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,

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

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)

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

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

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

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)

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

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