[DebugInfo][flang]Added support for representing Fortran assumed length strings

[SouraVX]

Summary

This patch adds support for representing Fortran character(n).

Primarily patch is based out of D54114 with appropriate modifications.

Test case IR is generated using our downstream classic-flang. We're in process
of upstreaming flang PR's but classic-flang has dependencies on llvm, so
this has to get in first.

Patch includes functional test case for both IR and corresponding
dwarf, furthermore it has been manually tested as well using GDB.

Source snippet:

program assumedLength
  call sub('Hello')
  call sub('Goodbye')
  contains
  subroutine sub(string)
          implicit none
          character(len=*), intent(in) :: string
          print *, string
  end subroutine sub
end program assumedLength

GDB:

(gdb) ptype string
type = character (5)
(gdb) p string
$1 = 'Hello'

Co-authored By: Erich Schweitz <[e-mail]>, Bhuvanendra Kumar [e-mail]>

[SouraVX]

llvm/docs/SourceLevelDebugging.rst

1065

I did not know much about by Doxygen, is the missing new-line will cause failure ?

[aprantl]

Thanks, this looks good to me — I just have a few inline comments.

llvm/docs/SourceLevelDebugging.rst

1057

DWARF tags

1069

same here

llvm/include/llvm/IR/DebugInfoMetadata.h

852

Are these copy&paste errors?

llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp

787

// For eventual Unicode support.

llvm/lib/IR/LLVMContextImpl.h

429

My guess is that we can get away with only hashing Tag+Name, or Tag+Size+Encoding, but I'll leave that up to you.

[SouraVX]

llvm/include/llvm/IR/DebugInfoMetadata.h

852

Nope, just for backward compatilbility I guess ? just like other nodes. Notice one expects MDString and other one StringRef

[aprantl]

llvm/include/llvm/IR/DebugInfoMetadata.h

852

I see. But since this is a new node, we don't need all the variants with the default arguments, do we? I think I'd be more comfortable with the minimal set we can get away with.

[SouraVX]

Addressed @aprantl review comments. Thanks for reviewing this!
Changes:

• Reduced to minimal variants.
• And other Nit comments.

[SouraVX]

llvm/include/llvm/IR/DebugInfoMetadata.h

852

This looks reasonable ?

llvm/lib/IR/LLVMContextImpl.h

429

Trimmed down to Tag + Name + Encoding.
Thanks for pointing this out!

[SouraVX]

Thanks @aprantl for reviewing this. Let's wait for @schweitz also to have a look. Planning to land this tomorrow or so.

[schweitz]

llvm/include/llvm/Bitcode/LLVMBitCodes.h

342

Wasn't this gap in the numbering because METADATA_STRING_TYPE originally came before METADATA_COMMON_BLOCK in my original changes?

[SouraVX]

llvm/include/llvm/Bitcode/LLVMBitCodes.h

342

For the record yes! Looking at the history, GAP 40 - 44 was introduced in when COOMMON BLOCK was introduced in D54327.
It shouldn't cause an issue. But for uniformities sake should we make it 41 ? this will reduce the GAP and we can follow this for upcoming in this direction.
@aprantl you want to add on this ?

[SouraVX]

Updated BitCodes for DIString to 41, this will narrow down the gap. Moving forward when introducing new metadata we can use 42-43 bits to compensate the gap.

[schweitz]

Thanks, Sourabh. That will help sync these patches with our internal branch. Glad to see this get upstreamed.

[schweitz]

You might want to add "[flang]" to the subject line as this change supports Fortran. Thanx.

[SouraVX]

In D86305#2230711, @schweitz wrote:

You might want to add "[flang]" to the subject line as this change supports Fortran. Thanx.

Done!, will wait for @aprantl to have another look, before pushing.

[aprantl]

I'm fine with whatever numbering makes your development the easiest. My only ask is that if we still have a gap after this, please document what nodes are expected to go there, so there 1) won't be any future conflicts and 2) we don't pointlessly reserve space.

[SouraVX]

In D86305#2230724, @aprantl wrote:

I'm fine with whatever numbering makes your development the easiest. My only ask is that if we still have a gap after this, please document what nodes are expected to go there, so there 1) won't be any future conflicts and 2) we don't pointlessly reserve space.

I'll have to re-confirm with our team. Making sure we don't break anything is priority for us.
@schweitz do you have any reservations WRT this ?

[SouraVX]

In D86305#2230794, @SouraVX wrote:

In D86305#2230724, @aprantl wrote:

I'm fine with whatever numbering makes your development the easiest. My only ask is that if we still have a gap after this, please document what nodes are expected to go there, so there 1) won't be any future conflicts and 2) we don't pointlessly reserve space.

I'll have to re-confirm with our team. Making sure we don't break anything is priority for us.
@schweitz do you have any reservations WRT this ?

We don't have any reservations with bit 42 and 43. If @schweitz also don't have any reservations we can mark/document them to be usable by others.

[schweitz]

In D86305#2230837, @SouraVX wrote:

In D86305#2230794, @SouraVX wrote:

In D86305#2230724, @aprantl wrote:

I'm fine with whatever numbering makes your development the easiest. My only ask is that if we still have a gap after this, please document what nodes are expected to go there, so there 1) won't be any future conflicts and 2) we don't pointlessly reserve space.

I'll have to re-confirm with our team. Making sure we don't break anything is priority for us.
@schweitz do you have any reservations WRT this ?

We don't have any reservations with bit 42 and 43. If @schweitz also don't have any reservations we can mark/document them to be usable by others.

42 and 43 are being used on our branch to support Fortran array debugging.

[schweitz]

In D86305#2230794, @SouraVX wrote:

In D86305#2230724, @aprantl wrote:

I'm fine with whatever numbering makes your development the easiest. My only ask is that if we still have a gap after this, please document what nodes are expected to go there, so there 1) won't be any future conflicts and 2) we don't pointlessly reserve space.

I'll have to re-confirm with our team. Making sure we don't break anything is priority for us.
@schweitz do you have any reservations WRT this ?

Sounds good to me.

[SouraVX]

Added comments for reserved bit codes.

[aprantl]

Thanks!

[SouraVX]

I don't know what's the criteria for arc land for removing strings from commit message. I added 2 Co-author: Eric Schweitz and Bhuvanendra kumar(from AMD). But apparently it dropped it when landing the actual patch. :(
Are you guys Okay with this ?
Anyway, I'll modify the summary here as well(for attributing co-author's).

llvm/docs/SourceLevelDebugging.rst

 .. code-block:: text
 
   DW_TAG_subprogram [3]  
      DW_AT_low_pc [DW_FORM_addr]     (0x0000000000000010 ".text")
      DW_AT_high_pc [DW_FORM_data4]   (0x00000001)
      ...
      DW_AT_elemental [DW_FORM_flag_present]  (true)
 
+There are a few DWARF tags defined to represent Fortran specific constructs i.e DW_TAG_string_type for representing Fortran character(n). In LLVM this is represented as DIStringType.
+
+.. code-block:: fortran
+
+  character(len=*), intent(in) :: string
+
+a Fortran front-end would generate the following descriptors:
+
+.. code-block:: text
+
+  !DILocalVariable(name: "string", arg: 1, scope: !10, file: !3, line: 4, type: !15)
+  !DIStringType(name: "character(*)!2", stringLength: !16, stringLengthExpression: !DIExpression(), size: 32)
+
+and this will materialize in DWARF tags as:
+
+.. code-block:: text
+
+   DW_TAG_string_type
+                DW_AT_name      ("character(*)!2")
+                DW_AT_string_length     (0x00000064)
+   0x00000064:    DW_TAG_variable
+                  DW_AT_location      (DW_OP_fbreg +16)
+                  DW_AT_type  (0x00000083 "integer*8")
+                  ...
+                  DW_AT_artificial    (true)
+
 Debugging information format
 ============================
 
 Debugging Information Extension for Objective C Properties
 ----------------------------------------------------------
 
 Introduction
 ^^^^^^^^^^^^

llvm/include/llvm-c/DebugInfo.h

enum {
   LLVMDITemplateValueParameterMetadataKind,
   LLVMDIGlobalVariableMetadataKind,
   LLVMDILocalVariableMetadataKind,
   LLVMDILabelMetadataKind,
   LLVMDIObjCPropertyMetadataKind,
   LLVMDIImportedEntityMetadataKind,
   LLVMDIMacroMetadataKind,
   LLVMDIMacroFileMetadataKind,
-  LLVMDICommonBlockMetadataKind
+  LLVMDICommonBlockMetadataKind,
+  LLVMDIStringTypeMetadataKind
 };
 typedef unsigned LLVMMetadataKind;
 
 /**
  * An LLVM DWARF type encoding.
  */
 typedef unsigned LLVMDWARFTypeEncoding;
 

llvm/include/llvm/Bitcode/LLVMBitCodes.h

enum MetadataCodes {
   METADATA_MACRO = 33,           // [distinct, macinfo, line, name, value]
   METADATA_MACRO_FILE = 34,      // [distinct, macinfo, line, file, ...]
   METADATA_STRINGS = 35,         // [count, offset] blob([lengths][chars])
   METADATA_GLOBAL_DECL_ATTACHMENT = 36, // [valueid, n x [id, mdnode]]
   METADATA_GLOBAL_VAR_EXPR = 37,        // [distinct, var, expr]
   METADATA_INDEX_OFFSET = 38,           // [offset]
   METADATA_INDEX = 39,                  // [bitpos]
   METADATA_LABEL = 40,                  // [distinct, scope, name, file, line]
-  METADATA_COMMON_BLOCK = 44,     // [distinct, scope, name, variable,...]
+  METADATA_STRING_TYPE = 41,            // [distinct, name, size, align,...]
+  // Codes 42 and 43 are reserved for support for Fortran array specific debug
+  // info.
+  METADATA_COMMON_BLOCK = 44 // [distinct, scope, name, variable,...]
 };
 
 // The constants block (CONSTANTS_BLOCK_ID) describes emission for each
 // constant and maintains an implicit current type value.
 enum ConstantsCodes {
   CST_CODE_SETTYPE = 1,          // SETTYPE:       [typeid]
   CST_CODE_NULL = 2,             // NULL
   CST_CODE_UNDEF = 3,            // UNDEF

llvm/include/llvm/IR/DIBuilder.h

public:
     /// \param Name        Type name.
     /// \param SizeInBits  Size of the type.
     /// \param Encoding    DWARF encoding code, e.g., dwarf::DW_ATE_float.
     /// \param Flags       Optional DWARF attributes, e.g., DW_AT_endianity.
     DIBasicType *createBasicType(StringRef Name, uint64_t SizeInBits,
                                  unsigned Encoding,
                                  DINode::DIFlags Flags = DINode::FlagZero);
 
+    /// Create debugging information entry for a string
+    /// type.
+    /// \param Name        Type name.
+    /// \param SizeInBits  Size of the type.
+    DIStringType *createStringType(StringRef Name, uint64_t SizeInBits);
+
     /// Create debugging information entry for a qualified
     /// type, e.g. 'const int'.
     /// \param Tag         Tag identifing type, e.g. dwarf::TAG_volatile_type
     /// \param FromTy      Base Type.
     DIDerivedType *createQualifiedType(unsigned Tag, DIType *FromTy);
 
     /// Create debugging information entry for a pointer.
     /// \param PointeeTy         Type pointed by this pointer.

llvm/include/llvm/IR/DebugInfoMetadata.h

#include "llvm/IR/DebugInfoFlags.def"
   static bool classof(const Metadata *MD) {
     switch (MD->getMetadataID()) {
     default:
       return false;
     case GenericDINodeKind:
     case DISubrangeKind:
     case DIEnumeratorKind:
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:
     case DISubprogramKind:
     case DILexicalBlockKind:
     case DILexicalBlockFileKind:
return isa<DIFile>(this) ? const_cast<DIScope *>(this)
                              : static_cast<Metadata *>(getOperand(0));
   }
 
   static bool classof(const Metadata *MD) {
     switch (MD->getMetadataID()) {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:
     case DISubprogramKind:
     case DILexicalBlockKind:
     case DILexicalBlockFileKind:
public:
   bool isLittleEndian() const { return getFlags() & FlagLittleEndian; }
   bool getExportSymbols() const { return getFlags() & FlagExportSymbols; }
 
   static bool classof(const Metadata *MD) {
     switch (MD->getMetadataID()) {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
     case DISubroutineTypeKind:
       return true;
     }
   }
 };
 
TempDIBasicType cloneImpl() const {
     return getTemporary(getContext(), getTag(), getName(), getSizeInBits(),
                         getAlignInBits(), getEncoding(), getFlags());
   }
 
 public:
   DEFINE_MDNODE_GET(DIBasicType, (unsigned Tag, StringRef Name),
                     (Tag, Name, 0, 0, 0, FlagZero))
   DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, StringRef Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0, FlagZero))
+  DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, MDString *Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0, FlagZero))
+  DEFINE_MDNODE_GET(DIBasicType,
                     (unsigned Tag, StringRef Name, uint64_t SizeInBits,
                      uint32_t AlignInBits, unsigned Encoding, DIFlags Flags),
                     (Tag, Name, SizeInBits, AlignInBits, Encoding, Flags))
   DEFINE_MDNODE_GET(DIBasicType,
                     (unsigned Tag, MDString *Name, uint64_t SizeInBits,
                      uint32_t AlignInBits, unsigned Encoding, DIFlags Flags),
                     (Tag, Name, SizeInBits, AlignInBits, Encoding, Flags))
 
   TempDIBasicType clone() const { return cloneImpl(); }
 
   unsigned getEncoding() const { return Encoding; }
 
   enum class Signedness { Signed, Unsigned };
 
   /// Return the signedness of this type, or None if this type is neither
   /// signed nor unsigned.
   Optional<Signedness> getSignedness() const;
 
   static bool classof(const Metadata *MD) {
     return MD->getMetadataID() == DIBasicTypeKind;
   }
 };
 
+/// String type, Fortran CHARACTER(n)
+class DIStringType : public DIType {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  unsigned Encoding;
+
+  DIStringType(LLVMContext &C, StorageType Storage, unsigned Tag,
+               uint64_t SizeInBits, uint32_t AlignInBits, unsigned Encoding,
+               ArrayRef<Metadata *> Ops)
+      : DIType(C, DIStringTypeKind, Storage, Tag, 0, SizeInBits, AlignInBits, 0,
+               FlagZero, Ops),
+        Encoding(Encoding) {}
+  ~DIStringType() = default;
+
+  static DIStringType *getImpl(LLVMContext &Context, unsigned Tag,
+                               StringRef Name, Metadata *StringLength,
+                               Metadata *StrLenExp, uint64_t SizeInBits,
+                               uint32_t AlignInBits, unsigned Encoding,
+                               StorageType Storage, bool ShouldCreate = true) {
+    return getImpl(Context, Tag, getCanonicalMDString(Context, Name),
+                   StringLength, StrLenExp, SizeInBits, AlignInBits, Encoding,
+                   Storage, ShouldCreate);
+  }
+  static DIStringType *getImpl(LLVMContext &Context, unsigned Tag,
+                               MDString *Name, Metadata *StringLength,
+                               Metadata *StrLenExp, uint64_t SizeInBits,
+                               uint32_t AlignInBits, unsigned Encoding,
+                               StorageType Storage, bool ShouldCreate = true);
+
+  TempDIStringType cloneImpl() const {
+    return getTemporary(getContext(), getTag(), getRawName(),
+                        getRawStringLength(), getRawStringLengthExp(),
+                        getSizeInBits(), getAlignInBits(), getEncoding());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, StringRef Name, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, nullptr, nullptr, SizeInBits, AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, MDString *Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits, unsigned Encoding),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, Encoding))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, StringRef Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits, unsigned Encoding),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, Encoding))
+
+  TempDIStringType clone() const { return cloneImpl(); }
+
+  static bool classof(const Metadata *MD) {
+    return MD->getMetadataID() == DIStringTypeKind;
+  }
+
+  DIVariable *getStringLength() const {
+    return cast_or_null<DIVariable>(getRawStringLength());
+  }
+
+  DIExpression *getStringLengthExp() const {
+    return cast_or_null<DIExpression>(getRawStringLengthExp());
+  }
+
+  unsigned getEncoding() const { return Encoding; }
+
+  Metadata *getRawStringLength() const { return getOperand(3); }
+
+  Metadata *getRawStringLengthExp() const { return getOperand(4); }
+};
+
 /// Derived types.
 ///
 /// This includes qualified types, pointers, references, friends, typedefs, and
 /// class members.
 ///
 /// TODO: Split out members (inheritance, fields, methods, etc.).
 class DIDerivedType : public DIType {
   friend class LLVMContextImpl;

llvm/include/llvm/IR/Metadata.def

 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DILocalVariable)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DILabel)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIObjCProperty)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIImportedEntity)
 HANDLE_SPECIALIZED_MDNODE_BRANCH(DIMacroNode)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIMacro)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIMacroFile)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DICommonBlock)
+HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIStringType)
 
 #undef HANDLE_METADATA
 #undef HANDLE_METADATA_LEAF
 #undef HANDLE_METADATA_BRANCH
 #undef HANDLE_MDNODE_LEAF
 #undef HANDLE_MDNODE_LEAF_UNIQUABLE
 #undef HANDLE_MDNODE_BRANCH
 #undef HANDLE_SPECIALIZED_MDNODE_LEAF
 #undef HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE
 #undef HANDLE_SPECIALIZED_MDNODE_BRANCH

llvm/lib/AsmParser/LLParser.cpp

#define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
   PARSE_MD_FIELDS();
 #undef VISIT_MD_FIELDS
 
   Result = GET_OR_DISTINCT(DIBasicType, (Context, tag.Val, name.Val, size.Val,
                                          align.Val, encoding.Val, flags.Val));
   return false;
 }
 
+/// ParseDIStringType:
+///   ::= !DIStringType(name: "character(4)", size: 32, align: 32)
+bool LLParser::ParseDIStringType(MDNode *&Result, bool IsDistinct) {
+#define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
+  OPTIONAL(tag, DwarfTagField, (dwarf::DW_TAG_string_type));                   \
+  OPTIONAL(name, MDStringField, );                                             \
+  OPTIONAL(stringLength, MDField, );                                           \
+  OPTIONAL(stringLengthExpression, MDField, );                                 \
+  OPTIONAL(size, MDUnsignedField, (0, UINT64_MAX));                            \
+  OPTIONAL(align, MDUnsignedField, (0, UINT32_MAX));                           \
+  OPTIONAL(encoding, DwarfAttEncodingField, );
+  PARSE_MD_FIELDS();
+#undef VISIT_MD_FIELDS
+
+  Result = GET_OR_DISTINCT(DIStringType,
+                           (Context, tag.Val, name.Val, stringLength.Val,
+                            stringLengthExpression.Val, size.Val, align.Val,
+                            encoding.Val));
+  return false;
+}
+
 /// ParseDIDerivedType:
 ///   ::= !DIDerivedType(tag: DW_TAG_pointer_type, name: "int", file: !0,
 ///                      line: 7, scope: !1, baseType: !2, size: 32,
 ///                      align: 32, offset: 0, flags: 0, extraData: !3,
 ///                      dwarfAddressSpace: 3)
 bool LLParser::ParseDIDerivedType(MDNode *&Result, bool IsDistinct) {
 #define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
   REQUIRED(tag, DwarfTagField, );                                              \

llvm/lib/Bitcode/Reader/MetadataLoader.cpp

case BitstreamEntry::Record: {
       case bitc::METADATA_VALUE:
       case bitc::METADATA_DISTINCT_NODE:
       case bitc::METADATA_NODE:
       case bitc::METADATA_LOCATION:
       case bitc::METADATA_GENERIC_DEBUG:
       case bitc::METADATA_SUBRANGE:
       case bitc::METADATA_ENUMERATOR:
       case bitc::METADATA_BASIC_TYPE:
+      case bitc::METADATA_STRING_TYPE:
       case bitc::METADATA_DERIVED_TYPE:
       case bitc::METADATA_COMPOSITE_TYPE:
       case bitc::METADATA_SUBROUTINE_TYPE:
       case bitc::METADATA_MODULE:
       case bitc::METADATA_FILE:
       case bitc::METADATA_COMPILE_UNIT:
       case bitc::METADATA_SUBPROGRAM:
       case bitc::METADATA_LEXICAL_BLOCK:
case bitc::METADATA_BASIC_TYPE: {
     MetadataList.assignValue(
         GET_OR_DISTINCT(DIBasicType,
                         (Context, Record[1], getMDString(Record[2]), Record[3],
                          Record[4], Record[5], Flags)),
         NextMetadataNo);
     NextMetadataNo++;
     break;
   }
+  case bitc::METADATA_STRING_TYPE: {
+    if (Record.size() != 8)
+      return error("Invalid record");
+
+    IsDistinct = Record[0];
+    MetadataList.assignValue(
+        GET_OR_DISTINCT(DIStringType,
+                        (Context, Record[1], getMDString(Record[2]),
+                         getMDOrNull(Record[3]), getMDOrNull(Record[4]),
+                         Record[5], Record[6], Record[7])),
+        NextMetadataNo);
+    NextMetadataNo++;
+    break;
+  }
   case bitc::METADATA_DERIVED_TYPE: {
     if (Record.size() < 12 || Record.size() > 13)
       return error("Invalid record");
 
     // DWARF address space is encoded as N->getDWARFAddressSpace() + 1. 0 means
     // that there is no DWARF address space associated with DIDerivedType.
     Optional<unsigned> DWARFAddressSpace;
     if (Record.size() > 12 && Record[12])

llvm/lib/Bitcode/Writer/BitcodeWriter.cpp

private:
   void writeGenericDINode(const GenericDINode *N,
                           SmallVectorImpl<uint64_t> &Record, unsigned &Abbrev);
   void writeDISubrange(const DISubrange *N, SmallVectorImpl<uint64_t> &Record,
                        unsigned Abbrev);
   void writeDIEnumerator(const DIEnumerator *N,
                          SmallVectorImpl<uint64_t> &Record, unsigned Abbrev);
   void writeDIBasicType(const DIBasicType *N, SmallVectorImpl<uint64_t> &Record,
                         unsigned Abbrev);
+  void writeDIStringType(const DIStringType *N,
+                         SmallVectorImpl<uint64_t> &Record, unsigned Abbrev);
   void writeDIDerivedType(const DIDerivedType *N,
                           SmallVectorImpl<uint64_t> &Record, unsigned Abbrev);
   void writeDICompositeType(const DICompositeType *N,
                             SmallVectorImpl<uint64_t> &Record, unsigned Abbrev);
   void writeDISubroutineType(const DISubroutineType *N,
                              SmallVectorImpl<uint64_t> &Record,
                              unsigned Abbrev);
   void writeDIFile(const DIFile *N, SmallVectorImpl<uint64_t> &Record,
void ModuleBitcodeWriter::writeDIBasicType(const DIBasicType *N,
   Record.push_back(N->getAlignInBits());
   Record.push_back(N->getEncoding());
   Record.push_back(N->getFlags());
 
   Stream.EmitRecord(bitc::METADATA_BASIC_TYPE, Record, Abbrev);
   Record.clear();
 }
 
+void ModuleBitcodeWriter::writeDIStringType(const DIStringType *N,
+                                            SmallVectorImpl<uint64_t> &Record,
+                                            unsigned Abbrev) {
+  Record.push_back(N->isDistinct());
+  Record.push_back(N->getTag());
+  Record.push_back(VE.getMetadataOrNullID(N->getRawName()));
+  Record.push_back(VE.getMetadataOrNullID(N->getStringLength()));
+  Record.push_back(VE.getMetadataOrNullID(N->getStringLengthExp()));
+  Record.push_back(N->getSizeInBits());
+  Record.push_back(N->getAlignInBits());
+  Record.push_back(N->getEncoding());
+
+  Stream.EmitRecord(bitc::METADATA_STRING_TYPE, Record, Abbrev);
+  Record.clear();
+}
+
 void ModuleBitcodeWriter::writeDIDerivedType(const DIDerivedType *N,
                                              SmallVectorImpl<uint64_t> &Record,
                                              unsigned Abbrev) {
   Record.push_back(N->isDistinct());
   Record.push_back(N->getTag());
   Record.push_back(VE.getMetadataOrNullID(N->getRawName()));
   Record.push_back(VE.getMetadataOrNullID(N->getFile()));
   Record.push_back(N->getLine());

llvm/lib/CodeGen/AsmPrinter/DebugLocEntry.h

Values.erase(std::unique(Values.begin(), Values.end(),
                  Values.end());
   }
 
   /// Lower this entry into a DWARF expression.
   void finalize(const AsmPrinter &AP,
                 DebugLocStream::ListBuilder &List,
                 const DIBasicType *BT,
                 DwarfCompileUnit &TheCU);
+
+  void finalize(const AsmPrinter &AP, DebugLocStream::ListBuilder &List,
+                const DIStringType *ST);
 };
 
 /// Compare two DbgValueLocs for equality.
 inline bool operator==(const DbgValueLoc &A,
                        const DbgValueLoc &B) {
   if (A.EntryKind != B.EntryKind)
     return false;
 

llvm/lib/CodeGen/AsmPrinter/DwarfDebug.h

class DwarfDebug : public DebugHandlerBase {
   // 0, referencing the comp_dir of all the type units that use it.
   MCDwarfDwoLineTable SplitTypeUnitFileTable;
   /// @}
 
   /// True iff there are multiple CUs in this module.
   bool SingleCU;
   bool IsDarwin;
 
+  /// Map for tracking Fortran deferred CHARACTER lengths.
+  DenseMap<const DIStringType *, unsigned> StringTypeLocMap;
+
   AddressPool AddrPool;
 
   /// Accelerator tables.
   AccelTable<DWARF5AccelTableData> AccelDebugNames;
   AccelTable<AppleAccelTableOffsetData> AccelNames;
   AccelTable<AppleAccelTableOffsetData> AccelObjC;
   AccelTable<AppleAccelTableOffsetData> AccelNamespace;
   AccelTable<AppleAccelTableTypeData> AccelTypes;
public:
   bool isLexicalScopeDIENull(LexicalScope *Scope);
 
   /// Find the matching DwarfCompileUnit for the given CU DIE.
   DwarfCompileUnit *lookupCU(const DIE *Die) { return CUDieMap.lookup(Die); }
   const DwarfCompileUnit *lookupCU(const DIE *Die) const {
     return CUDieMap.lookup(Die);
   }
 
+  unsigned getStringTypeLoc(const DIStringType *ST) const {
+    auto I = StringTypeLocMap.find(ST);
+    return I != StringTypeLocMap.end() ? I->second : 0;
+  }
+
+  void addStringTypeLoc(const DIStringType *ST, unsigned Loc) {
+    assert(ST);
+    if (Loc)
+      StringTypeLocMap[ST] = Loc;
+  }
+
   /// \defgroup DebuggerTuning Predicates to tune DWARF for a given debugger.
   ///
   /// Returns whether we are "tuning" for a given debugger.
   /// @{
   bool tuneForGDB() const { return DebuggerTuning == DebuggerKind::GDB; }
   bool tuneForLLDB() const { return DebuggerTuning == DebuggerKind::LLDB; }
   bool tuneForSCE() const { return DebuggerTuning == DebuggerKind::SCE; }
   /// @}

llvm/lib/CodeGen/AsmPrinter/DwarfUnit.h

protected:
   /// create a new ID and insert it in the line table.
   virtual unsigned getOrCreateSourceID(const DIFile *File) = 0;
 
   /// Emit the common part of the header for this unit.
   void emitCommonHeader(bool UseOffsets, dwarf::UnitType UT);
 
 private:
   void constructTypeDIE(DIE &Buffer, const DIBasicType *BTy);
+  void constructTypeDIE(DIE &Buffer, const DIStringType *BTy);
   void constructTypeDIE(DIE &Buffer, const DIDerivedType *DTy);
   void constructTypeDIE(DIE &Buffer, const DISubroutineType *CTy);
   void constructSubrangeDIE(DIE &Buffer, const DISubrange *SR, DIE *IndexTy);
   void constructArrayTypeDIE(DIE &Buffer, const DICompositeType *CTy);
   void constructEnumTypeDIE(DIE &Buffer, const DICompositeType *CTy);
   DIE &constructMemberDIE(DIE &Buffer, const DIDerivedType *DT);
   void constructTemplateTypeParameterDIE(DIE &Buffer,
                                          const DITemplateTypeParameter *TP);

llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp

DIE *DwarfUnit::createTypeDIE(const DIScope *Context, DIE &ContextDIE,
                               const DIType *Ty) {
   // Create new type.
   DIE &TyDIE = createAndAddDIE(Ty->getTag(), ContextDIE, Ty);
 
   updateAcceleratorTables(Context, Ty, TyDIE);
 
   if (auto *BT = dyn_cast<DIBasicType>(Ty))
     constructTypeDIE(TyDIE, BT);
+  else if (auto *ST = dyn_cast<DIStringType>(Ty))
+    constructTypeDIE(TyDIE, ST);
   else if (auto *STy = dyn_cast<DISubroutineType>(Ty))
     constructTypeDIE(TyDIE, STy);
   else if (auto *CTy = dyn_cast<DICompositeType>(Ty)) {
     if (DD->generateTypeUnits() && !Ty->isForwardDecl() &&
         (Ty->getRawName() || CTy->getRawIdentifier())) {
       // Skip updating the accelerator tables since this is not the full type.
       if (MDString *TypeId = CTy->getRawIdentifier())
         DD->addDwarfTypeUnitType(getCU(), TypeId->getString(), TyDIE, CTy);
void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIBasicType *BTy) {
   // Add name if not anonymous or intermediate type.
   if (!Name.empty())
     addString(Buffer, dwarf::DW_AT_name, Name);
 
   // An unspecified type only has a name attribute.
   if (BTy->getTag() == dwarf::DW_TAG_unspecified_type)
     return;
 
+  if (BTy->getTag() != dwarf::DW_TAG_string_type)
     addUInt(Buffer, dwarf::DW_AT_encoding, dwarf::DW_FORM_data1,
             BTy->getEncoding());
 
   uint64_t Size = BTy->getSizeInBits() >> 3;
   addUInt(Buffer, dwarf::DW_AT_byte_size, None, Size);
 
   if (BTy->isBigEndian())
     addUInt(Buffer, dwarf::DW_AT_endianity, None, dwarf::DW_END_big);
   else if (BTy->isLittleEndian())
     addUInt(Buffer, dwarf::DW_AT_endianity, None, dwarf::DW_END_little);
 }
 
+void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIStringType *STy) {
+  // Get core information.
+  StringRef Name = STy->getName();
+  // Add name if not anonymous or intermediate type.
+  if (!Name.empty())
+    addString(Buffer, dwarf::DW_AT_name, Name);
+
+  if (DIVariable *Var = STy->getStringLength()) {
+    if (auto *VarDIE = getDIE(Var))
+      addDIEEntry(Buffer, dwarf::DW_AT_string_length, *VarDIE);
+  } else {
+    uint64_t Size = STy->getSizeInBits() >> 3;
+    addUInt(Buffer, dwarf::DW_AT_byte_size, None, Size);
+  }
+
+  if (STy->getEncoding()) {
+    // For eventual Unicode support.
+    addUInt(Buffer, dwarf::DW_AT_encoding, dwarf::DW_FORM_data1,
+            STy->getEncoding());
+  }
+}
+
 void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIDerivedType *DTy) {
   // Get core information.
   StringRef Name = DTy->getName();
   uint64_t Size = DTy->getSizeInBits() >> 3;
   uint16_t Tag = Buffer.getTag();
 
   // Map to main type, void will not have a type.
   const DIType *FromTy = DTy->getBaseType();

llvm/lib/IR/AsmWriter.cpp

static void writeDIBasicType(raw_ostream &Out, const DIBasicType *N,
   Printer.printInt("size", N->getSizeInBits());
   Printer.printInt("align", N->getAlignInBits());
   Printer.printDwarfEnum("encoding", N->getEncoding(),
                          dwarf::AttributeEncodingString);
   Printer.printDIFlags("flags", N->getFlags());
   Out << ")";
 }
 
+static void writeDIStringType(raw_ostream &Out, const DIStringType *N,
+                              TypePrinting *TypePrinter, SlotTracker *Machine,
+                              const Module *Context) {
+  Out << "!DIStringType(";
+  MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
+  if (N->getTag() != dwarf::DW_TAG_string_type)
+    Printer.printTag(N);
+  Printer.printString("name", N->getName());
+  Printer.printMetadata("stringLength", N->getRawStringLength());
+  Printer.printMetadata("stringLengthExpression", N->getRawStringLengthExp());
+  Printer.printInt("size", N->getSizeInBits());
+  Printer.printInt("align", N->getAlignInBits());
+  Printer.printDwarfEnum("encoding", N->getEncoding(),
+                         dwarf::AttributeEncodingString);
+  Out << ")";
+}
+
 static void writeDIDerivedType(raw_ostream &Out, const DIDerivedType *N,
                                TypePrinting *TypePrinter, SlotTracker *Machine,
                                const Module *Context) {
   Out << "!DIDerivedType(";
   MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
   Printer.printTag(N);
   Printer.printString("name", N->getName());
   Printer.printMetadata("scope", N->getRawScope());

llvm/lib/IR/DIBuilder.cpp

 DIBasicType *DIBuilder::createBasicType(StringRef Name, uint64_t SizeInBits,
                                         unsigned Encoding,
                                         DINode::DIFlags Flags) {
   assert(!Name.empty() && "Unable to create type without name");
   return DIBasicType::get(VMContext, dwarf::DW_TAG_base_type, Name, SizeInBits,
                           0, Encoding, Flags);
 }
 
+DIStringType *DIBuilder::createStringType(StringRef Name, uint64_t SizeInBits) {
+  assert(!Name.empty() && "Unable to create type without name");
+  return DIStringType::get(VMContext, dwarf::DW_TAG_string_type, Name,
+                           SizeInBits, 0);
+}
+
 DIDerivedType *DIBuilder::createQualifiedType(unsigned Tag, DIType *FromTy) {
   return DIDerivedType::get(VMContext, Tag, "", nullptr, 0, nullptr, FromTy, 0,
                             0, 0, None, DINode::FlagZero);
 }
 
 DIDerivedType *DIBuilder::createPointerType(
     DIType *PointeeTy,
     uint64_t SizeInBits,

llvm/lib/IR/DebugInfoMetadata.cpp

Optional<DIBasicType::Signedness> DIBasicType::getSignedness() const {
   case dwarf::DW_ATE_unsigned:
   case dwarf::DW_ATE_unsigned_char:
     return Signedness::Unsigned;
   default:
     return None;
   }
 }
 
+DIStringType *DIStringType::getImpl(LLVMContext &Context, unsigned Tag,
+                                    MDString *Name, Metadata *StringLength,
+                                    Metadata *StringLengthExp,
+                                    uint64_t SizeInBits, uint32_t AlignInBits,
+                                    unsigned Encoding, StorageType Storage,
+                                    bool ShouldCreate) {
+  assert(isCanonical(Name) && "Expected canonical MDString");
+  DEFINE_GETIMPL_LOOKUP(DIStringType, (Tag, Name, StringLength, StringLengthExp,
+                                       SizeInBits, AlignInBits, Encoding));
+  Metadata *Ops[] = {nullptr, nullptr, Name, StringLength, StringLengthExp};
+  DEFINE_GETIMPL_STORE(DIStringType, (Tag, SizeInBits, AlignInBits, Encoding),
+                       Ops);
+}
+
 DIDerivedType *DIDerivedType::getImpl(
     LLVMContext &Context, unsigned Tag, MDString *Name, Metadata *File,
     unsigned Line, Metadata *Scope, Metadata *BaseType, uint64_t SizeInBits,
     uint32_t AlignInBits, uint64_t OffsetInBits,
     Optional<unsigned> DWARFAddressSpace, DIFlags Flags, Metadata *ExtraData,
     StorageType Storage, bool ShouldCreate) {
   assert(isCanonical(Name) && "Expected canonical MDString");
   DEFINE_GETIMPL_LOOKUP(DIDerivedType,

llvm/lib/IR/LLVMContextImpl.h

return Tag == RHS->getTag() && Name == RHS->getRawName() &&
            Flags == RHS->getFlags();
   }
 
   unsigned getHashValue() const {
     return hash_combine(Tag, Name, SizeInBits, AlignInBits, Encoding);
   }
 };
 
+template <> struct MDNodeKeyImpl<DIStringType> {
+  unsigned Tag;
+  MDString *Name;
+  Metadata *StringLength;
+  Metadata *StringLengthExp;
+  uint64_t SizeInBits;
+  uint32_t AlignInBits;
+  unsigned Encoding;
+
+  MDNodeKeyImpl(unsigned Tag, MDString *Name, Metadata *StringLength,
+                Metadata *StringLengthExp, uint64_t SizeInBits,
+                uint32_t AlignInBits, unsigned Encoding)
+      : Tag(Tag), Name(Name), StringLength(StringLength),
+        StringLengthExp(StringLengthExp), SizeInBits(SizeInBits),
+        AlignInBits(AlignInBits), Encoding(Encoding) {}
+  MDNodeKeyImpl(const DIStringType *N)
+      : Tag(N->getTag()), Name(N->getRawName()),
+        StringLength(N->getRawStringLength()),
+        StringLengthExp(N->getRawStringLengthExp()),
+        SizeInBits(N->getSizeInBits()), AlignInBits(N->getAlignInBits()),
+        Encoding(N->getEncoding()) {}
+
+  bool isKeyOf(const DIStringType *RHS) const {
+    return Tag == RHS->getTag() && Name == RHS->getRawName() &&
+           SizeInBits == RHS->getSizeInBits() &&
+           AlignInBits == RHS->getAlignInBits() &&
+           Encoding == RHS->getEncoding();
+  }
+  unsigned getHashValue() const { return hash_combine(Tag, Name, Encoding); }
+};
+
 template <> struct MDNodeKeyImpl<DIDerivedType> {
   unsigned Tag;
   MDString *Name;
   Metadata *File;
   unsigned Line;
   Metadata *Scope;
   Metadata *BaseType;
   uint64_t SizeInBits;

llvm/lib/IR/Verifier.cpp

 }
 
 void Verifier::visitDIEnumerator(const DIEnumerator &N) {
   AssertDI(N.getTag() == dwarf::DW_TAG_enumerator, "invalid tag", &N);
 }
 
 void Verifier::visitDIBasicType(const DIBasicType &N) {
   AssertDI(N.getTag() == dwarf::DW_TAG_base_type ||
-               N.getTag() == dwarf::DW_TAG_unspecified_type,
+               N.getTag() == dwarf::DW_TAG_unspecified_type ||
+               N.getTag() == dwarf::DW_TAG_string_type,
            "invalid tag", &N);
+}
+
+void Verifier::visitDIStringType(const DIStringType &N) {
+  AssertDI(N.getTag() == dwarf::DW_TAG_string_type, "invalid tag", &N);
   AssertDI(!(N.isBigEndian() && N.isLittleEndian()) ,
             "has conflicting flags", &N);
 }
 
 void Verifier::visitDIDerivedType(const DIDerivedType &N) {
   // Common scope checks.
   visitDIScope(N);
 

llvm/test/DebugInfo/distringtype.ll

+;; Test for !DIStringType.!DIStringType is used to construct a Fortran
+;; CHARACTER intrinsic type, with a LEN type parameter where LEN is a
+;; dynamic parameter as in a deferred-length CHARACTER. LLVM after
+;; processing this !DIStringType metadata, generates DW_AT_string_length attribute.
+;; !DIStringType(name: "character(*)", stringLength: !{{[0-9]+}},
+;;    stringLengthExpression: !DIExpression(), size: 32)
+
+; RUN: llc -filetype=obj  %s -o - | llvm-dwarfdump - | FileCheck %s
+; CHECK:       DW_TAG_string_type
+; CHECK:                          DW_AT_name  ("character(*)!2")
+; CHECK-NEXT:                     DW_AT_string_length
+
+;; sample fortran testcase involving assumed length string type.
+;; program assumedLength
+;;   call sub('Hello')
+;;   call sub('Goodbye')
+;;   contains
+;;   subroutine sub(string)
+;;           implicit none
+;;           character(len=*), intent(in) :: string
+;;           print *, string
+;;   end subroutine sub
+;; end program assumedLength
+
+; ModuleID = 'test.ll'
+source_filename = "test.ll"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+%struct.struct_ul_MAIN__324 = type <{ i8* }>
+
+@.C327_MAIN_ = internal constant [7 x i8] c"Goodbye"
+@.C326_MAIN_ = internal constant [5 x i8] c"Hello"
+@.C306_MAIN_ = internal constant i32 0
+@.C336_assumedlength_sub = internal constant i32 14
+@.C306_assumedlength_sub = internal constant i32 0
+@.C307_assumedlength_sub = internal constant i64 0
+@.C331_assumedlength_sub = internal constant i32 6
+@.C329_assumedlength_sub = internal constant [8 x i8] c"test.f90"
+@.C328_assumedlength_sub = internal constant i32 8
+
+define void @MAIN_() !dbg !5 {
+L.entry:
+  %.S0000_331 = alloca %struct.struct_ul_MAIN__324, align 8
+  %0 = bitcast i32* @.C306_MAIN_ to i8*, !dbg !8
+  %1 = bitcast void (...)* @fort_init to void (i8*, ...)*, !dbg !8
+  call void (i8*, ...) %1(i8* %0), !dbg !8
+  br label %L.LB1_335
+
+L.LB1_335:                                        ; preds = %L.entry
+  %2 = bitcast [5 x i8]* @.C326_MAIN_ to i64*, !dbg !9
+  %3 = bitcast %struct.struct_ul_MAIN__324* %.S0000_331 to i64*, !dbg !9
+  call void @assumedlength_sub(i64* %2, i64 5, i64* %3), !dbg !9
+  %4 = bitcast [7 x i8]* @.C327_MAIN_ to i64*, !dbg !10
+  %5 = bitcast %struct.struct_ul_MAIN__324* %.S0000_331 to i64*, !dbg !10
+  call void @assumedlength_sub(i64* %4, i64 7, i64* %5), !dbg !10
+  ret void, !dbg !11
+}
+
+define internal void @assumedlength_sub(i64* noalias %string, i64 %.U0001.arg, i64* noalias %.S0000) !dbg !12 {
+L.entry:
+  %.U0001.addr = alloca i64, align 8
+  %z__io_333 = alloca i32, align 4
+  call void @llvm.dbg.declare(metadata i64* %string, metadata !16, metadata !DIExpression()), !dbg !20
+  store i64 %.U0001.arg, i64* %.U0001.addr, align 8
+  call void @llvm.dbg.declare(metadata i64* %.U0001.addr, metadata !18, metadata !DIExpression()), !dbg !20
+  call void @llvm.dbg.declare(metadata i64* %.S0000, metadata !21, metadata !DIExpression()), !dbg !20
+  br label %L.LB2_347
+
+L.LB2_347:                                        ; preds = %L.entry
+  %0 = bitcast i32* @.C328_assumedlength_sub to i8*, !dbg !23
+  %1 = bitcast [8 x i8]* @.C329_assumedlength_sub to i8*, !dbg !23
+  %2 = bitcast void (...)* @f90io_src_info03a to void (i8*, i8*, i64, ...)*, !dbg !23
+  call void (i8*, i8*, i64, ...) %2(i8* %0, i8* %1, i64 8), !dbg !23
+  %3 = bitcast i32* @.C331_assumedlength_sub to i8*, !dbg !23
+  %4 = bitcast i32* @.C306_assumedlength_sub to i8*, !dbg !23
+  %5 = bitcast i32* @.C306_assumedlength_sub to i8*, !dbg !23
+  %6 = bitcast i32 (...)* @f90io_print_init to i32 (i8*, i8*, i8*, i8*, ...)*, !dbg !23
+  %7 = call i32 (i8*, i8*, i8*, i8*, ...) %6(i8* %3, i8* null, i8* %4, i8* %5), !dbg !23
+  call void @llvm.dbg.declare(metadata i32* %z__io_333, metadata !24, metadata !DIExpression()), !dbg !20
+  store i32 %7, i32* %z__io_333, align 4, !dbg !23
+  %8 = bitcast i64* %string to i8*, !dbg !23
+  %9 = load i64, i64* %.U0001.addr, align 8, !dbg !23
+  %10 = bitcast i32 (...)* @f90io_sc_ch_ldw to i32 (i8*, i32, i64, ...)*, !dbg !23
+  %11 = call i32 (i8*, i32, i64, ...) %10(i8* %8, i32 14, i64 %9), !dbg !23
+  store i32 %11, i32* %z__io_333, align 4, !dbg !23
+  %12 = call i32 (...) @f90io_ldw_end(), !dbg !23
+  store i32 %12, i32* %z__io_333, align 4, !dbg !23
+  ret void, !dbg !26
+}
+
+declare signext i32 @f90io_ldw_end(...)
+
+declare signext i32 @f90io_sc_ch_ldw(...)
+
+declare signext i32 @f90io_print_init(...)
+
+declare void @f90io_src_info03a(...)
+
+; Function Attrs: nounwind readnone speculatable willreturn
+declare void @llvm.dbg.declare(metadata, metadata, metadata)
+
+declare void @fort_init(...)
+
+!llvm.module.flags = !{!0, !1}
+!llvm.dbg.cu = !{!2}
+
+!0 = !{i32 2, !"Dwarf Version", i32 4}
+!1 = !{i32 2, !"Debug Info Version", i32 3}
+!2 = distinct !DICompileUnit(language: DW_LANG_Fortran90, file: !3, producer: " F90 Flang - 1.5 2017-05-01", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !4, retainedTypes: !4, globals: !4, imports: !4)
+!3 = !DIFile(filename: "test.f90", directory: "/tmp")
+!4 = !{}
+!5 = distinct !DISubprogram(name: "assumedlength", scope: !2, file: !3, line: 1, type: !6, scopeLine: 1, spFlags: DISPFlagDefinition | DISPFlagMainSubprogram, unit: !2)
+!6 = !DISubroutineType(cc: DW_CC_program, types: !7)
+!7 = !{null}
+!8 = !DILocation(line: 1, column: 1, scope: !5)
+!9 = !DILocation(line: 2, column: 1, scope: !5)
+!10 = !DILocation(line: 3, column: 1, scope: !5)
+!11 = !DILocation(line: 4, column: 1, scope: !5)
+!12 = distinct !DISubprogram(name: "sub", scope: !5, file: !3, line: 5, type: !13, scopeLine: 5, spFlags: DISPFlagLocalToUnit | DISPFlagDefinition, unit: !2)
+!13 = !DISubroutineType(types: !14)
+!14 = !{null, !15}
+!15 = !DIStringType(name: "character(*)!1", size: 32)
+!16 = !DILocalVariable(name: "string", arg: 1, scope: !12, file: !3, type: !17)
+!17 = !DIStringType(name: "character(*)!2", stringLength: !18, stringLengthExpression: !DIExpression(), size: 32)
+!18 = !DILocalVariable(arg: 2, scope: !12, file: !3, type: !19, flags: DIFlagArtificial)
+!19 = !DIBasicType(name: "integer*8", size: 64, align: 64, encoding: DW_ATE_signed)
+!20 = !DILocation(line: 0, scope: !12)
+!21 = !DILocalVariable(arg: 3, scope: !12, file: !3, type: !22, flags: DIFlagArtificial)
+!22 = !DIBasicType(name: "uinteger*8", size: 64, align: 64, encoding: DW_ATE_unsigned)
+!23 = !DILocation(line: 8, column: 1, scope: !12)
+!24 = distinct !DILocalVariable(scope: !12, file: !3, type: !25, flags: DIFlagArtificial)
+!25 = !DIBasicType(name: "integer", size: 32, align: 32, encoding: DW_ATE_signed)
+!26 = !DILocation(line: 9, column: 1, scope: !12)

llvm/test/DebugInfo/fortran-string-type.ll

+;; Test for !DIStringType. This DI is used to construct a Fortran CHARACTER
+;; intrinsic type, either with a compile-time constant LEN type parameter or
+;; when LEN is a dynamic parameter as in a deferred-length CHARACTER.  (See
+;; section 7.4.4 of the Fortran 2018 standard.)
+
+; RUN: llvm-as < %s | llvm-dis | llvm-as | llvm-dis | FileCheck %s
+; CHECK: !DIStringType(name: "character(*)", stringLength: !{{[0-9]+}}, stringLengthExpression: !DIExpression(), size: 32)
+; CHECK: !DIStringType(name: "character(10)", size: 80, align: 8)
+; CHECK: !DIBasicType(tag: DW_TAG_string_type
+
+!llvm.module.flags = !{!0, !1}
+!llvm.dbg.cu = !{!2}
+
+!0 = !{i32 2, !"Dwarf Version", i32 4}
+!1 = !{i32 1, !"Debug Info Version", i32 3}
+!2 = distinct !DICompileUnit(language: DW_LANG_Fortran90, file: !3, producer: "Flang", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !4, retainedTypes: !5, globals: !4, imports: !4)
+!3 = !DIFile(filename: "fortran-string-type.f", directory: "/")
+!4 = !{}
+!5 = !{!6, !9, !12, !13}
+!6 = !DIStringType(name: "character(*)", stringLength: !7, stringLengthExpression: !DIExpression(), size: 32)
+!7 = !DILocalVariable(arg: 2, scope: !8, file: !3, line: 256, type: !11, flags: DIFlagArtificial)
+!8 = distinct !DISubprogram(name: "subprgm", scope: !2, file: !3, line: 256, type: !9, isLocal: false, isDefinition: true, scopeLine: 256, isOptimized: false, unit: !2)
+!9 = !DISubroutineType(types: !10)
+!10 = !{null, !6, !11}
+!11 = !DIBasicType(name: "integer*8", size: 64, align: 64, encoding: DW_ATE_signed)
+!12 = !DIStringType(name: "character(10)", size: 80, align: 8)
+!13 = !DIBasicType(tag: DW_TAG_string_type, name: "character")