[flang] Semantic checks for C702

C702 (R701) A colon shall not be used as a type-param-value except in the
declaration of an entity that has the POINTER or ALLOCATABLE attribute.

I added code to the visitor for a TypeDeclarationStmt to check for the
'LEN' type parameter for strings and to loop over the type parameters
for derived types.

I also ran into a few situations where previous tests had erroneously
used a colon for type parameters without either the POINTER or
ALLOCATABLE attribute and fixed them up.

Original-commit: flang-compiler/f18@a1a95bfcd1811d697f1386fe57af664b8a16ffb5
Reviewed-on: https://github.com/flang-compiler/f18/pull/973

diff --git a/flang/lib/semantics/resolve-names.cpp b/flang/lib/semantics/resolve-names.cpp
index a7b76d6..a964f85 100644 (file)
--- a/flang/lib/semantics/resolve-names.cpp
+++ b/flang/lib/semantics/resolve-names.cpp
@@ -720,7 +720,7 @@ public:
   void Post(const parser::DimensionStmt::Declaration &);
   void Post(const parser::CodimensionDecl &);
   bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
-  void Post(const parser::TypeDeclarationStmt &) { EndDecl(); }
+  void Post(const parser::TypeDeclarationStmt &);
   void Post(const parser::IntegerTypeSpec &);
   void Post(const parser::IntrinsicTypeSpec::Real &);
   void Post(const parser::IntrinsicTypeSpec::Complex &);
@@ -2889,6 +2889,29 @@ bool DeclarationVisitor::CheckAccessibleComponent(
   return false;
 }
 
+void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
+  if (!GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {  // C702
+    if (const auto *typeSpec{GetDeclTypeSpec()}) {
+      if (typeSpec->category() == DeclTypeSpec::Character) {
+        if (typeSpec->characterTypeSpec().length().isDeferred()) {
+          Say("The type parameter LEN cannot be deferred without"
+              " the POINTER or ALLOCATABLE attribute"_err_en_US);
+        }
+      } else if (const DerivedTypeSpec * derivedSpec{typeSpec->AsDerived()}) {
+        for (const auto &pair : derivedSpec->parameters()) {
+          if (pair.second.isDeferred()) {
+            Say(currStmtSource().value(),
+                "The value of type parameter '%s' cannot be deferred"
+                " without the POINTER or ALLOCATABLE attribute"_err_en_US,
+                pair.first);
+          }
+        }
+      }
+    }
+  }
+  EndDecl();
+}
+
 void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
   const auto &name{std::get<parser::Name>(x.t)};
   DeclareObjectEntity(name, Attrs{});
@@ -3522,7 +3545,7 @@ bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
   // so POINTER & ALLOCATABLE enable forward references to derived types.
   Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
   set_allowForwardReferenceToDerivedType(
-      GetAttrs().test(Attr::POINTER) || GetAttrs().test(Attr::ALLOCATABLE));
+      GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
   Walk(std::get<parser::DeclarationTypeSpec>(x.t));
   set_allowForwardReferenceToDerivedType(false);
   Walk(std::get<std::list<parser::ComponentDecl>>(x.t));

diff --git a/flang/test/evaluate/folding05.f90 b/flang/test/evaluate/folding05.f90
index d6d8a45..5e5e5c5 100644 (file)
Binary files a/flang/test/evaluate/folding05.f90 and b/flang/test/evaluate/folding05.f90 differ

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index 2dd1198..c69569b 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -99,6 +99,7 @@ set(ERROR_TESTS
   resolve66.f90
   resolve67.f90
   resolve68.f90
+  resolve69.f90
   stop01.f90
   structconst01.f90
   structconst02.f90

diff --git a/flang/test/semantics/allocate03.f90 b/flang/test/semantics/allocate03.f90
index dcdb2d5..f86b44c 100644 (file)
--- a/flang/test/semantics/allocate03.f90
+++ b/flang/test/semantics/allocate03.f90
@@ -34,7 +34,7 @@ subroutine C933_a(b1, ca3, ca4, cp3, cp3mold, cp4, cp7, cp8, bsrc)
   type(SomeType(1, l1=3)), pointer :: cp9, cp10(:)
 
   type(B(*)) b1
-  type(B(:)) b2
+  type(B(:)), allocatable :: b2
   type(B(5)) b3
 
   type(SomeType(4, *, 8)) bsrc

diff --git a/flang/test/semantics/allocate09.f90 b/flang/test/semantics/allocate09.f90
index ca83b68..49736f9 100644 (file)
--- a/flang/test/semantics/allocate09.f90
+++ b/flang/test/semantics/allocate09.f90
@@ -26,12 +26,12 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred)
   real(kind=8) srcx8, srcx8_array(10)
   class(WithParam(4, 2)) src_a_4_2
   type(WithParam(8, 2)) src_a_8_2
-  class(WithParam(4, :)) src_a_4_def
-  class(WithParam(8, :)) src_a_8_def
+  class(WithParam(4, :)), allocatable :: src_a_4_def
+  class(WithParam(8, :)), allocatable :: src_a_8_def
   type(WithParamExtent(4, 2, 8, 3)) src_b_4_2_8_3
-  class(WithParamExtent(4, :, 8, 3)) src_b_4_def_8_3
+  class(WithParamExtent(4, :, 8, 3)), allocatable :: src_b_4_def_8_3
   type(WithParamExtent(8, 2, 8, 3)) src_b_8_2_8_3
-  class(WithParamExtent(8, :, 8, 3)) src_b_8_def_8_3
+  class(WithParamExtent(8, :, 8, 3)), allocatable :: src_b_8_def_8_3
   type(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, l3=8 )) src_c_4_5_5_6_8_8
   class(WithParamExtent2(k1=4, l1=2, k2=5, l2=6, k3=5, l3=8)) src_c_4_2_5_6_5_8
   class(WithParamExtent2(k2=5, l2=6, k3=5, l3=8)) src_c_1_2_5_6_5_8

diff --git a/flang/test/semantics/modfile28.f90 b/flang/test/semantics/modfile28.f90
index 12c17b1..c53ab04 100644 (file)
--- a/flang/test/semantics/modfile28.f90
+++ b/flang/test/semantics/modfile28.f90
@@ -3,20 +3,20 @@
 ! Note: Module files are encoded in UTF-8.
 
 module m
-character(kind=4,len=:), parameter :: c4 = 4_"Hi! 你好!"
+character(kind=4,len=*), parameter :: c4 = 4_"Hi! 你好!"
 ! In CHARACTER(1) literals, codepoints > 0xff are serialized into UTF-8;
 ! each of those bytes then gets encoded into UTF-8 for the module file.
-character(kind=1,len=:), parameter :: c1 = 1_"Hi! 你好!"
-character(kind=4,len=:), parameter :: c4a(*) = [4_"一", 4_"二", 4_"三", 4_"四", 4_"五"]
+character(kind=1,len=*), parameter :: c1 = 1_"Hi! 你好!"
+character(kind=4,len=*), parameter :: c4a(*) = [4_"一", 4_"二", 4_"三", 4_"四", 4_"五"]
 integer, parameter :: lc4 = len(c4)
 integer, parameter :: lc1 = len(c1)
 end module m
 
 !Expect: m.mod
 !module m
-!character(:,4),parameter::c4=4_"Hi! \344\275\240\345\245\275!"
-!character(:,1),parameter::c1=1_"Hi! \344\275\240\345\245\275!"
-!character(:,4),parameter::c4a(1_8:*)=[CHARACTER(KIND=4,LEN=1)::4_"\344\270\200",4_"\344\272\214",4_"\344\270\211",4_"\345\233\233",4_"\344\272\224"]
+!character(*,4),parameter::c4=4_"Hi! \344\275\240\345\245\275!"
+!character(*,1),parameter::c1=1_"Hi! \344\275\240\345\245\275!"
+!character(*,4),parameter::c4a(1_8:*)=[CHARACTER(KIND=4,LEN=1)::4_"\344\270\200",4_"\344\272\214",4_"\344\270\211",4_"\345\233\233",4_"\344\272\224"]
 !integer(4),parameter::lc4=7_4
 !intrinsic::len
 !integer(4),parameter::lc1=11_4

diff --git a/flang/test/semantics/resolve37.f90 b/flang/test/semantics/resolve37.f90
index e2d5f12..a33e370 100644 (file)
--- a/flang/test/semantics/resolve37.f90
+++ b/flang/test/semantics/resolve37.f90
@@ -1,3 +1,5 @@
+! C701 The type-param-value for a kind type parameter shall be a constant
+! expression.  This constraint looks like a mistake in the standard.
 integer, parameter :: k = 8
 real, parameter :: l = 8.0
 integer :: n = 2

diff --git a/flang/test/semantics/resolve69.f90 b/flang/test/semantics/resolve69.f90
new file mode 100644 (file)
index 0000000..5950f66
--- /dev/null
+++ b/flang/test/semantics/resolve69.f90
@@ -0,0 +1,45 @@
+subroutine s1()
+  ! C701 (R701) The type-param-value for a kind type parameter shall be a
+  ! constant expression.
+  ! C702 (R701) A colon shall not be used as a type-param-value except in the 
+  ! declaration of an entity that has the POINTER or ALLOCATABLE attribute.
+  integer, parameter :: constVal = 1
+  integer :: nonConstVal = 1
+!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
+  character(nonConstVal) :: colonString1
+  character(len=20, kind=constVal + 1) :: constKindString
+  character(len=:, kind=constVal + 1), pointer :: constKindString1
+!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
+  character(len=:, kind=constVal + 1) :: constKindString2
+!ERROR: Must be a constant value
+  character(len=20, kind=nonConstVal) :: nonConstKindString
+!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
+  character(len=:) :: deferredString
+!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
+  character(:) :: colonString2
+  !OK because of the allocatable attribute
+  character(:), allocatable :: colonString3
+
+  type derived(typeKind, typeLen)
+    integer, kind :: typeKind
+    integer, len :: typeLen
+  end type derived
+
+  type (derived(constVal, 3)) :: constDerivedKind
+!ERROR: Value of kind type parameter 'typekind' (nonconstval) is not a scalar INTEGER constant
+!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
+  type (derived(nonConstVal, 3)) :: nonConstDerivedKind
+
+  !OK because all type-params are constants
+  type (derived(3, constVal)) :: constDerivedLen
+
+!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
+  type (derived(3, nonConstVal)) :: nonConstDerivedLen
+!ERROR: The value of type parameter 'typelen' cannot be deferred without the POINTER or ALLOCATABLE attribute
+  type (derived(3, :)) :: colonDerivedLen
+!ERROR: The value of type parameter 'typekind' cannot be deferred without the POINTER or ALLOCATABLE attribute
+!ERROR: The value of type parameter 'typelen' cannot be deferred without the POINTER or ALLOCATABLE attribute
+  type (derived( :, :)) :: colonDerivedLen1
+  type (derived( :, :)), pointer :: colonDerivedLen2
+  type (derived(4, :)), pointer :: colonDerivedLen3
+end subroutine s1