[PATCH] D101482: [flang] Allow KIND type parameters to be used as LEN parameters of components

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld created this revision.
PeteSteinfeld added reviewers: klausler, tskeith.
PeteSteinfeld requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

When producing the runtime type information for a component of a derived type
that had a LEN type parameter, we were not allowing a KIND parameter of the
derived type.  This was causing one of the NAG correctness tests to fail
(.../hibiya/d5.f90).

I added a test to our own test suite to check for this.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D101482

Files:
  flang/include/flang/Evaluate/tools.h
  flang/lib/Semantics/runtime-type-info.cpp
  flang/test/Semantics/resolve69.f90


Index: flang/test/Semantics/resolve69.f90
===================================================================
--- flang/test/Semantics/resolve69.f90
+++ flang/test/Semantics/resolve69.f90
@@ -33,6 +33,8 @@
   type derived(typeKind, typeLen)
     integer, kind :: typeKind
     integer, len :: typeLen
+    character(typeKind) :: kindValue
+    character(typeLen) :: lenValue
   end type derived
 
   type (derived(constVal, 3)) :: constDerivedKind
@@ -53,3 +55,12 @@
   type (derived( :, :)), pointer :: colonDerivedLen2
   type (derived(4, :)), pointer :: colonDerivedLen3
 end subroutine s1
+Program d5
+  Type string(maxlen)
+    Integer,Kind :: maxlen
+    Character(maxlen) :: value
+  End Type
+  Type(string(80)) line
+  line%value = 'ok'
+  Print *,Trim(line%value)
+End Program
Index: flang/lib/Semantics/runtime-type-info.cpp
===================================================================
--- flang/lib/Semantics/runtime-type-info.cpp
+++ flang/lib/Semantics/runtime-type-info.cpp
@@ -94,13 +94,15 @@
     }
     if (expr) {
       if (parameters) {
-        if (const Symbol * lenParam{evaluate::ExtractBareLenParameter(*expr)}) {
+        if (const Symbol *
+            lenParam{evaluate::ExtractBareLenOrKindParameter(*expr)}) {
           return PackageIntValue(
               lenParameterEnum_, FindLenParameterIndex(*parameters, *lenParam));
         }
       }
       context_.Say(location_,
-          "Specification expression '%s' is neither constant nor a length type parameter"_err_en_US,
+          "Specification expression '%s' is neither constant nor a length or "
+          "kind type parameter"_err_en_US,
           expr->AsFortran());
     }
     return PackageIntValue(deferredEnum_);
Index: flang/include/flang/Evaluate/tools.h
===================================================================
--- flang/include/flang/Evaluate/tools.h
+++ flang/include/flang/Evaluate/tools.h
@@ -210,16 +210,18 @@
   return nullptr;
 }
 
-// When an expression is a "bare" LEN= derived type parameter inquiry,
+// When an expression is a "bare" LEN= or KIND= derived type parameter inquiry,
 // possibly wrapped in integer kind conversions &/or parentheses, return
 // a pointer to the Symbol with TypeParamDetails.
-template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) {
+template <typename A>
+const Symbol *ExtractBareLenOrKindParameter(const A &expr) {
   if (const auto *typeParam{
           evaluate::UnwrapConvertedExpr<evaluate::TypeParamInquiry>(expr)}) {
     if (!typeParam->base()) {
       const Symbol &symbol{typeParam->parameter()};
       if (const auto *tpd{symbol.detailsIf<semantics::TypeParamDetails>()}) {
-        if (tpd->attr() == common::TypeParamAttr::Len) {
+        if (tpd->attr() == common::TypeParamAttr::Len ||
+            tpd->attr() == common::TypeParamAttr::Kind) {
           return &symbol;
         }
       }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D101482.341297.patch
Type: text/x-patch
Size: 2899 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210428/a0598f68/attachment.bin>