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

Sourabh Singh Tomar via llvm-commits llvm-commits at lists.llvm.org
Fri Aug 21 21:44:09 PDT 2020


Author: Sourabh Singh Tomar
Date: 2020-08-22T10:13:40+05:30
New Revision: f91d18eaa946b2d2ea5a9334fb099c3e409ad2d1

URL: https://github.com/llvm/llvm-project/commit/f91d18eaa946b2d2ea5a9334fb099c3e409ad2d1
DIFF: https://github.com/llvm/llvm-project/commit/f91d18eaa946b2d2ea5a9334fb099c3e409ad2d1.diff

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

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'
```

Reviewed By: aprantl, schweitz

Differential Revision: https://reviews.llvm.org/D86305

Added: 
    llvm/test/DebugInfo/distringtype.ll
    llvm/test/DebugInfo/fortran-string-type.ll

Modified: 
    llvm/docs/SourceLevelDebugging.rst
    llvm/include/llvm-c/DebugInfo.h
    llvm/include/llvm/Bitcode/LLVMBitCodes.h
    llvm/include/llvm/IR/DIBuilder.h
    llvm/include/llvm/IR/DebugInfoMetadata.h
    llvm/include/llvm/IR/Metadata.def
    llvm/lib/AsmParser/LLParser.cpp
    llvm/lib/Bitcode/Reader/MetadataLoader.cpp
    llvm/lib/Bitcode/Writer/BitcodeWriter.cpp
    llvm/lib/CodeGen/AsmPrinter/DebugLocEntry.h
    llvm/lib/CodeGen/AsmPrinter/DwarfDebug.h
    llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp
    llvm/lib/CodeGen/AsmPrinter/DwarfUnit.h
    llvm/lib/IR/AsmWriter.cpp
    llvm/lib/IR/DIBuilder.cpp
    llvm/lib/IR/DebugInfoMetadata.cpp
    llvm/lib/IR/LLVMContextImpl.h
    llvm/lib/IR/Verifier.cpp

Removed: 
    


################################################################################
diff  --git a/llvm/docs/SourceLevelDebugging.rst b/llvm/docs/SourceLevelDebugging.rst
index 7944d09dba58..e5984cd86ec9 100644
--- a/llvm/docs/SourceLevelDebugging.rst
+++ b/llvm/docs/SourceLevelDebugging.rst
@@ -1054,6 +1054,32 @@ and this will materialize an additional DWARF attribute as:
      ...
      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
 ============================
 

diff  --git a/llvm/include/llvm-c/DebugInfo.h b/llvm/include/llvm-c/DebugInfo.h
index cdf5f5a0cca8..9b07abf0393a 100644
--- a/llvm/include/llvm-c/DebugInfo.h
+++ b/llvm/include/llvm-c/DebugInfo.h
@@ -159,7 +159,8 @@ enum {
   LLVMDIImportedEntityMetadataKind,
   LLVMDIMacroMetadataKind,
   LLVMDIMacroFileMetadataKind,
-  LLVMDICommonBlockMetadataKind
+  LLVMDICommonBlockMetadataKind,
+  LLVMDIStringTypeMetadataKind
 };
 typedef unsigned LLVMMetadataKind;
 

diff  --git a/llvm/include/llvm/Bitcode/LLVMBitCodes.h b/llvm/include/llvm/Bitcode/LLVMBitCodes.h
index 452918cde64b..613391ad05ed 100644
--- a/llvm/include/llvm/Bitcode/LLVMBitCodes.h
+++ b/llvm/include/llvm/Bitcode/LLVMBitCodes.h
@@ -338,7 +338,10 @@ enum MetadataCodes {
   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

diff  --git a/llvm/include/llvm/IR/DIBuilder.h b/llvm/include/llvm/IR/DIBuilder.h
index d1c7d126b5a9..0c788a173859 100644
--- a/llvm/include/llvm/IR/DIBuilder.h
+++ b/llvm/include/llvm/IR/DIBuilder.h
@@ -199,6 +199,12 @@ namespace llvm {
                                  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

diff  --git a/llvm/include/llvm/IR/DebugInfoMetadata.h b/llvm/include/llvm/IR/DebugInfoMetadata.h
index 6e57e6d79cb7..d49e1376d842 100644
--- a/llvm/include/llvm/IR/DebugInfoMetadata.h
+++ b/llvm/include/llvm/IR/DebugInfoMetadata.h
@@ -182,6 +182,7 @@ class DINode : public MDNode {
     case DISubrangeKind:
     case DIEnumeratorKind:
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
     case DISubroutineTypeKind:
@@ -451,6 +452,7 @@ class DIScope : public DINode {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
     case DISubroutineTypeKind:
@@ -697,6 +699,7 @@ class DIType : public DIScope {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
     case DISubroutineTypeKind:
@@ -746,6 +749,12 @@ class DIBasicType : public DIType {
 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),
@@ -770,6 +779,81 @@ class DIBasicType : public DIType {
   }
 };
 
+/// 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

diff  --git a/llvm/include/llvm/IR/Metadata.def b/llvm/include/llvm/IR/Metadata.def
index 1df60cadac08..ed9977392cde 100644
--- a/llvm/include/llvm/IR/Metadata.def
+++ b/llvm/include/llvm/IR/Metadata.def
@@ -114,6 +114,7 @@ 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

diff  --git a/llvm/lib/AsmParser/LLParser.cpp b/llvm/lib/AsmParser/LLParser.cpp
index fec10b8605c2..63f8531dbdce 100644
--- a/llvm/lib/AsmParser/LLParser.cpp
+++ b/llvm/lib/AsmParser/LLParser.cpp
@@ -4637,6 +4637,27 @@ bool LLParser::ParseDIBasicType(MDNode *&Result, bool IsDistinct) {
   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,

diff  --git a/llvm/lib/Bitcode/Reader/MetadataLoader.cpp b/llvm/lib/Bitcode/Reader/MetadataLoader.cpp
index 6fccb312164b..821185e46c04 100644
--- a/llvm/lib/Bitcode/Reader/MetadataLoader.cpp
+++ b/llvm/lib/Bitcode/Reader/MetadataLoader.cpp
@@ -853,6 +853,7 @@ MetadataLoader::MetadataLoaderImpl::lazyLoadModuleMetadataBlock() {
       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:
@@ -1325,6 +1326,20 @@ Error MetadataLoader::MetadataLoaderImpl::parseOneMetadata(
     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");

diff  --git a/llvm/lib/Bitcode/Writer/BitcodeWriter.cpp b/llvm/lib/Bitcode/Writer/BitcodeWriter.cpp
index 777a0e2ba129..329cbe4020a3 100644
--- a/llvm/lib/Bitcode/Writer/BitcodeWriter.cpp
+++ b/llvm/lib/Bitcode/Writer/BitcodeWriter.cpp
@@ -301,6 +301,8 @@ class ModuleBitcodeWriter : public ModuleBitcodeWriterBase {
                          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,
@@ -1590,6 +1592,22 @@ void ModuleBitcodeWriter::writeDIBasicType(const DIBasicType *N,
   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) {

diff  --git a/llvm/lib/CodeGen/AsmPrinter/DebugLocEntry.h b/llvm/lib/CodeGen/AsmPrinter/DebugLocEntry.h
index 36278f2e9e2d..4d145c9f80aa 100644
--- a/llvm/lib/CodeGen/AsmPrinter/DebugLocEntry.h
+++ b/llvm/lib/CodeGen/AsmPrinter/DebugLocEntry.h
@@ -178,6 +178,9 @@ class DebugLocEntry {
                 DebugLocStream::ListBuilder &List,
                 const DIBasicType *BT,
                 DwarfCompileUnit &TheCU);
+
+  void finalize(const AsmPrinter &AP, DebugLocStream::ListBuilder &List,
+                const DIStringType *ST);
 };
 
 /// Compare two DbgValueLocs for equality.

diff  --git a/llvm/lib/CodeGen/AsmPrinter/DwarfDebug.h b/llvm/lib/CodeGen/AsmPrinter/DwarfDebug.h
index 93e08d1151ff..a97d3680412b 100644
--- a/llvm/lib/CodeGen/AsmPrinter/DwarfDebug.h
+++ b/llvm/lib/CodeGen/AsmPrinter/DwarfDebug.h
@@ -412,6 +412,9 @@ class DwarfDebug : public DebugHandlerBase {
   bool SingleCU;
   bool IsDarwin;
 
+  /// Map for tracking Fortran deferred CHARACTER lengths.
+  DenseMap<const DIStringType *, unsigned> StringTypeLocMap;
+
   AddressPool AddrPool;
 
   /// Accelerator tables.
@@ -772,6 +775,17 @@ class DwarfDebug : public DebugHandlerBase {
     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.

diff  --git a/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp b/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp
index 11729842ff71..0f139f791d14 100644
--- a/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp
+++ b/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.cpp
@@ -635,6 +635,8 @@ DIE *DwarfUnit::createTypeDIE(const DIScope *Context, DIE &ContextDIE,
 
   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)) {
@@ -753,8 +755,9 @@ void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIBasicType *BTy) {
   if (BTy->getTag() == dwarf::DW_TAG_unspecified_type)
     return;
 
-  addUInt(Buffer, dwarf::DW_AT_encoding, dwarf::DW_FORM_data1,
-          BTy->getEncoding());
+  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);
@@ -765,6 +768,28 @@ void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIBasicType *BTy) {
     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();

diff  --git a/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.h b/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.h
index 18ad7e958c25..7147da33e631 100644
--- a/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.h
+++ b/llvm/lib/CodeGen/AsmPrinter/DwarfUnit.h
@@ -300,6 +300,7 @@ class DwarfUnit : public DIEUnit {
 
 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);

diff  --git a/llvm/lib/IR/AsmWriter.cpp b/llvm/lib/IR/AsmWriter.cpp
index 5e4b717f92c6..f43ddce0118b 100644
--- a/llvm/lib/IR/AsmWriter.cpp
+++ b/llvm/lib/IR/AsmWriter.cpp
@@ -1916,6 +1916,23 @@ static void writeDIBasicType(raw_ostream &Out, const DIBasicType *N,
   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) {

diff  --git a/llvm/lib/IR/DIBuilder.cpp b/llvm/lib/IR/DIBuilder.cpp
index 45cbbb3a6037..6717aa637e45 100644
--- a/llvm/lib/IR/DIBuilder.cpp
+++ b/llvm/lib/IR/DIBuilder.cpp
@@ -267,6 +267,12 @@ DIBasicType *DIBuilder::createBasicType(StringRef Name, uint64_t 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);

diff  --git a/llvm/lib/IR/DebugInfoMetadata.cpp b/llvm/lib/IR/DebugInfoMetadata.cpp
index bc2a4c0153cc..f20270810ed6 100644
--- a/llvm/lib/IR/DebugInfoMetadata.cpp
+++ b/llvm/lib/IR/DebugInfoMetadata.cpp
@@ -470,6 +470,20 @@ Optional<DIBasicType::Signedness> DIBasicType::getSignedness() const {
   }
 }
 
+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,

diff  --git a/llvm/lib/IR/LLVMContextImpl.h b/llvm/lib/IR/LLVMContextImpl.h
index e8fdaa23761c..0be283551ec2 100644
--- a/llvm/lib/IR/LLVMContextImpl.h
+++ b/llvm/lib/IR/LLVMContextImpl.h
@@ -397,6 +397,37 @@ template <> struct MDNodeKeyImpl<DIBasicType> {
   }
 };
 
+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;

diff  --git a/llvm/lib/IR/Verifier.cpp b/llvm/lib/IR/Verifier.cpp
index db52f36e4f10..d9e3a61e6fa2 100644
--- a/llvm/lib/IR/Verifier.cpp
+++ b/llvm/lib/IR/Verifier.cpp
@@ -926,8 +926,13 @@ void Verifier::visitDIEnumerator(const DIEnumerator &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);
 }

diff  --git a/llvm/test/DebugInfo/distringtype.ll b/llvm/test/DebugInfo/distringtype.ll
new file mode 100644
index 000000000000..b69dee3f6097
--- /dev/null
+++ b/llvm/test/DebugInfo/distringtype.ll
@@ -0,0 +1,134 @@
+;; 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* }>
+
+ at .C327_MAIN_ = internal constant [7 x i8] c"Goodbye"
+ at .C326_MAIN_ = internal constant [5 x i8] c"Hello"
+ at .C306_MAIN_ = internal constant i32 0
+ at .C336_assumedlength_sub = internal constant i32 14
+ at .C306_assumedlength_sub = internal constant i32 0
+ at .C307_assumedlength_sub = internal constant i64 0
+ at .C331_assumedlength_sub = internal constant i32 6
+ at .C329_assumedlength_sub = internal constant [8 x i8] c"test.f90"
+ at .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)

diff  --git a/llvm/test/DebugInfo/fortran-string-type.ll b/llvm/test/DebugInfo/fortran-string-type.ll
new file mode 100644
index 000000000000..cbd3b1b401dd
--- /dev/null
+++ b/llvm/test/DebugInfo/fortran-string-type.ll
@@ -0,0 +1,27 @@
+;; 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")


        


More information about the llvm-commits mailing list