Extensions to the LLVM debug information metadata to support the Fortran language.

[xoviat]

Summary

There are several new debug info constructs added here. They include the following.

!DIStringType :
Debug clients expect Fortran CHARACTER types to appear as
DW_TAG_string_type in the DWARF. !DIStringType can be used to generate
DWARF for constant and variable sized CHARACTER type variables. If the
size of a CHARACTER must be computed at run-time, DWARF specifies that
the DW_TAG_string_type has a DW_AT_string_length with a location expression.

!DIFortranArrayType and !DIFortranSubrange :
Debug clients expect Fortran arrays to specify the bounds of their
dimensions in DW_TAG_subrange_types. Both the lower and upper bounds can
be given by the programmer as constants, variables, a mix of constants
and variables, omitted, or as deferred. The DWARF standard requires
that these bounds appear in the DW_TAG_subrange_type. Debug clients
expect variable bounds to be encoded in blocks.

[aprantl]

Thank you very much for this patch!

In order to make this review manageable, could you please split out the review into one separate patch per feature you are adding?

There are no testcases covering the new features. Could you please add some?

Also note that we just recently extended DISubrange in LLVM: (see https://reviews.llvm.org/D41695 https://reviews.llvm.org/D41696 https://reviews.llvm.org/D41698). It would be good if your patch for Fortran array types could build on top of that.

[xoviat]

I'll come back with a smaller patch.

include/llvm/Bitcode/LLVMBitCodes.h

   METADATA_GLOBAL_VAR_EXPR = 37,        // [distinct, var, expr]
   METADATA_INDEX_OFFSET = 38,           // [offset]
   METADATA_INDEX = 39,                  // [bitpos]
+  METADATA_STRING_TYPE = 40,      // [distinct, name, size, align, ...]
+  METADATA_FORTRAN_ARRAY_TYPE = 41, // [distinct, name, [bounds ...], ...]
+  METADATA_FORTRAN_SUBRANGE = 42, // [distinct, lbound, lbnde, ubound, ubnde]
 };
 
 // The constants block (CONSTANTS_BLOCK_ID) describes emission for each

include/llvm/IR/DIBuilder.h

     DIBasicType *createBasicType(StringRef Name, uint64_t SizeInBits,
                                  unsigned Encoding);
 
+    /// 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

     DICompositeType *createArrayType(uint64_t Size, uint32_t AlignInBits,
                                      DIType *Ty, DINodeArray Subscripts);
 
+    /// Create debugging information entry for a Fortran array.
+    /// \param Size         Array size.
+    /// \param AlignInBits  Alignment.
+    /// \param Ty           Element type.
+    /// \param Subscripts   Subscripts.
+    DIFortranArrayType *createFortranArrayType(
+        uint64_t Size, uint32_t AlignInBits, DIType *Ty, DINodeArray Subs);
+
     /// Create debugging information entry for a vector type.
     /// \param Size         Array size.
     /// \param AlignInBits  Alignment.

     /// implicitly uniques the values returned.
     DISubrange *getOrCreateSubrange(int64_t Lo, int64_t Count);
 
+    /// Create a descriptor for a value range.  This
+    /// implicitly uniques the values returned.
+    DIFortranSubrange *getOrCreateFortranSubrange(
+        int64_t CLBound, int64_t CUBound, bool NoUBound, Metadata *Lbound,
+        Metadata * Lbndexp, Metadata *Ubound, Metadata * Ubndexp);
+
     /// Create a new descriptor for the specified variable.
     /// \param Context     Variable scope.
     /// \param Name        Name of the variable.

include/llvm/IR/DebugInfoFlags.def

 HANDLE_DI_FLAG((1 << 19), BitField)
 HANDLE_DI_FLAG((1 << 20), NoReturn)
 HANDLE_DI_FLAG((1 << 21), MainSubprogram)
+HANDLE_DI_FLAG((1 << 22), Pure)
+HANDLE_DI_FLAG((1 << 23), Elemental)
+HANDLE_DI_FLAG((1 << 24), Recursive)
 
 // To avoid needing a dedicated value for IndirectVirtualBase, we use
 // the bitwise or of Virtual and FwdDecl, which does not otherwise

 #ifdef DI_FLAG_LARGEST_NEEDED
 // intended to be used with ADT/BitmaskEnum.h
 // NOTE: always must be equal to largest flag, check this when adding new flag
-HANDLE_DI_FLAG((1 << 21), Largest)
+HANDLE_DI_FLAG((1 << 24), Largest)
 #undef DI_FLAG_LARGEST_NEEDED
 #endif
 

include/llvm/IR/DebugInfoMetadata.h

       return false;
     case GenericDINodeKind:
     case DISubrangeKind:
+    case DIFortranSubrangeKind:
     case DIEnumeratorKind:
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:

   }
 };
 
+/// Fortran array subrange
+class DIFortranSubrange : public DINode {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  int64_t CLowerBound;
+  int64_t CUpperBound;
+  bool NoUpperBound;
+
+  DIFortranSubrange(LLVMContext &C, StorageType Storage, int64_t CLowerBound,
+                    int64_t CUpperBound, bool NoUpperBound,
+                    ArrayRef<Metadata *> Ops)
+      : DINode(C, DIFortranSubrangeKind, Storage,
+               dwarf::DW_TAG_subrange_type, Ops), CLowerBound(CLowerBound),
+        CUpperBound(CUpperBound), NoUpperBound(NoUpperBound) {}
+  ~DIFortranSubrange() = default;
+
+  static DIFortranSubrange *getImpl(LLVMContext &Context, int64_t CLBound,
+                                    int64_t CUBound, bool NoUpperBound,
+                                    Metadata *Lbound, Metadata *Lbndexp,
+                                    Metadata *Ubound, Metadata *Ubndexp,
+                                    StorageType Storage,
+                                    bool ShouldCreate = true);
+
+  TempDIFortranSubrange cloneImpl() const {
+    return getTemporary(getContext(), getCLowerBound(), getCUpperBound(),
+                        noUpperBound(), getRawLowerBound(),
+                        getRawLowerBoundExpression(), getRawUpperBound(),
+                        getRawUpperBoundExpression());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIFortranSubrange, (int64_t CLB, int64_t CUB, bool NUB,
+                                        Metadata *LBound, Metadata *LBndExp,
+                                        Metadata *UBound, Metadata *UBndExp),
+                    (CLB, CUB, NUB, LBound, LBndExp, UBound, UBndExp))
+
+  TempDIFortranSubrange clone() const { return cloneImpl(); }
+
+  DIVariable *getLowerBound() const {
+    return cast_or_null<DIVariable>(getRawLowerBound());
+  }
+  DIExpression *getLowerBoundExp() const {
+    return cast_or_null<DIExpression>(getRawLowerBoundExpression());
+  }
+  DIVariable *getUpperBound() const {
+    return  cast_or_null<DIVariable>(getRawUpperBound());
+  }
+  DIExpression *getUpperBoundExp() const {
+    return cast_or_null<DIExpression>(getRawUpperBoundExpression());
+  }
+
+  int64_t getCLowerBound() const { return CLowerBound; }
+  int64_t getCUpperBound() const { return CUpperBound; }
+  Metadata *getRawLowerBound() const { return getOperand(0); }
+  Metadata *getRawLowerBoundExpression() const { return getOperand(1); }
+  Metadata *getRawUpperBound() const { return getOperand(2); }
+  Metadata *getRawUpperBoundExpression() const { return getOperand(3); }
+  bool noUpperBound() const { return NoUpperBound; }
+
+  static bool classof(const Metadata *MD) {
+    return MD->getMetadataID() == DIFortranSubrangeKind;
+  }
+};
+
 /// Enumeration value.
 ///
 /// TODO: Add a pointer to the context (DW_TAG_enumeration_type) once that no

     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:

     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
       return true;
     }

 public:
   DEFINE_MDNODE_GET(DIBasicType, (unsigned Tag, StringRef Name),
                     (Tag, Name, 0, 0, 0))
+  DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, StringRef Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0))
+  DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, MDString *Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0))
   DEFINE_MDNODE_GET(DIBasicType,
                     (unsigned Tag, StringRef Name, uint64_t SizeInBits,
                      uint32_t AlignInBits, unsigned Encoding),

   }
 };
 
+/// 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(), getName(), getRawStringLength(),
+                        getRawStringLengthExp(), getSizeInBits(),
+                        getAlignInBits(), getEncoding());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIStringType, (unsigned Tag, StringRef Name),
+                    (Tag, Name, nullptr, nullptr, 0, 0, 0))
+  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, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, nullptr, nullptr, SizeInBits, AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, StringRef Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, MDString *Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, 0))
+  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))
+  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))
+
+  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

   }
 };
 
+/// Fortran array types.
+class DIFortranArrayType : public DIType {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  DIFortranArrayType(LLVMContext &C, StorageType Storage, unsigned Tag,
+                     unsigned Line, uint64_t SizeInBits, uint32_t AlignInBits,
+                     uint64_t OffsetInBits, DIFlags Flags,
+                     ArrayRef<Metadata *> Ops)
+      : DIType(C, DIFortranArrayTypeKind, Storage, Tag, Line, SizeInBits,
+               AlignInBits, OffsetInBits, Flags, Ops) {}
+  ~DIFortranArrayType() = default;
+
+  static DIFortranArrayType *
+  getImpl(LLVMContext &Context, unsigned Tag, StringRef Name, Metadata *File,
+          unsigned Line, DIScopeRef Scope, DITypeRef BaseType,
+          uint64_t SizeInBits, uint32_t AlignInBits, uint64_t OffsetInBits,
+          DIFlags Flags, DINodeArray Elements, StorageType Storage,
+          bool ShouldCreate = true) {
+    return getImpl(
+        Context, Tag, getCanonicalMDString(Context, Name), File, Line, Scope,
+        BaseType, SizeInBits, AlignInBits, OffsetInBits, Flags, Elements.get(),
+        Storage, ShouldCreate);
+  }
+  static DIFortranArrayType *
+  getImpl(LLVMContext &Context, unsigned Tag, MDString *Name, Metadata *File,
+          unsigned Line, Metadata *Scope, Metadata *BaseType,
+          uint64_t SizeInBits, uint32_t AlignInBits, uint64_t OffsetInBits,
+          DIFlags Flags, Metadata *Elements, StorageType Storage,
+          bool ShouldCreate = true);
+
+  TempDIFortranArrayType cloneImpl() const {
+    return getTemporary(getContext(), getTag(), getName(), getFile(), getLine(),
+                        getScope(), getBaseType(), getSizeInBits(),
+                        getAlignInBits(), getOffsetInBits(), getFlags(),
+                        getElements());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIFortranArrayType,
+                    (unsigned Tag, StringRef Name, DIFile *File, unsigned Line,
+                     DIScopeRef Scope, DITypeRef BaseType, uint64_t SizeInBits,
+                     uint32_t AlignInBits, uint64_t OffsetInBits,
+                     DIFlags Flags, DINodeArray Elements),
+                    (Tag, Name, File, Line, Scope, BaseType, SizeInBits,
+                     AlignInBits, OffsetInBits, Flags, Elements))
+  DEFINE_MDNODE_GET(DIFortranArrayType,
+                    (unsigned Tag, MDString *Name, Metadata *File,
+                     unsigned Line, Metadata *Scope, Metadata *BaseType,
+                     uint64_t SizeInBits, uint32_t AlignInBits,
+                     uint64_t OffsetInBits, DIFlags Flags, Metadata *Elements),
+                    (Tag, Name, File, Line, Scope, BaseType, SizeInBits,
+                     AlignInBits, OffsetInBits, Flags, Elements))
+
+  TempDIFortranArrayType clone() const { return cloneImpl(); }
+
+  DITypeRef getBaseType() const { return DITypeRef(getRawBaseType()); }
+  DINodeArray getElements() const {
+    return cast_or_null<MDTuple>(getRawElements());
+  }
+
+  Metadata *getRawBaseType() const { return getOperand(3); }
+  Metadata *getRawElements() const { return getOperand(4); }
+
+  /// Replace operands.
+  ///
+  /// If this \a isUniqued() and not \a isResolved(), on a uniquing collision
+  /// this will be RAUW'ed and deleted.  Use a \a TrackingMDRef to keep track
+  /// of its movement if necessary.
+  /// @{
+  void replaceElements(DINodeArray Elements) {
+#ifndef NDEBUG
+    for (DINode *Op : getElements())
+      assert(is_contained(Elements->operands(), Op) &&
+             "Lost a member during member list replacement");
+#endif
+    replaceOperandWith(4, Elements.get());
+  }
+
+  static bool classof(const Metadata *MD) {
+    return MD->getMetadataID() == DIFortranArrayTypeKind;
+  }
+};
+
 /// Type array for a subprogram.
 ///
 /// TODO: Fold the array of types in directly as operands.

   bool isExplicit() const { return getFlags() & FlagExplicit; }
   bool isPrototyped() const { return getFlags() & FlagPrototyped; }
   bool isMainSubprogram() const { return getFlags() & FlagMainSubprogram; }
+  bool isPure() const { return getFlags() & FlagPure; }
+  bool isElemental() const { return getFlags() & FlagElemental; }
+  bool isRecursive() const { return getFlags() & FlagRecursive; }
 
   /// Check if this is reference-qualified.
   ///

include/llvm/IR/Metadata.def

 HANDLE_SPECIALIZED_MDNODE_BRANCH(DIMacroNode)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIMacro)
 HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIMacroFile)
+HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIStringType)
+HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIFortranArrayType)
+HANDLE_SPECIALIZED_MDNODE_LEAF_UNIQUABLE(DIFortranSubrange)
 
 #undef HANDLE_METADATA
 #undef HANDLE_METADATA_LEAF

lib/AsmParser/LLParser.cpp

   return false;
 }
 
+/// ParseDIFortranSubrange:
+///   ::= !DIFortranSubrange(lowerBound: 2)
+bool LLParser::ParseDIFortranSubrange(MDNode *&Result, bool IsDistinct) {
+#define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
+  OPTIONAL(constLowerBound, MDSignedField, (0, INT64_MIN, INT64_MAX));         \
+  OPTIONAL(constUpperBound, MDSignedField, (0, INT64_MIN, INT64_MAX));         \
+  OPTIONAL(lowerBound, MDField, );                                             \
+  OPTIONAL(lowerBoundExpression, MDField, );                                   \
+  OPTIONAL(upperBound, MDField, );                                             \
+  OPTIONAL(upperBoundExpression, MDField, );
+  PARSE_MD_FIELDS();
+#undef VISIT_MD_FIELDS
+
+  Result = GET_OR_DISTINCT(DIFortranSubrange,
+                           (Context, constLowerBound.Val, constUpperBound.Val,
+                            (!constUpperBound.Seen) && (!upperBound.Seen),
+                            lowerBound.Val, lowerBoundExpression.Val,
+                            upperBound.Val, upperBoundExpression.Val));
+  return false;
+}
+
+
 /// ParseDIEnumerator:
 ///   ::= !DIEnumerator(value: 30, name: "SomeKind")
 bool LLParser::ParseDIEnumerator(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,

   return false;
 }
 
+bool LLParser::ParseDIFortranArrayType(MDNode *&Result, bool IsDistinct) {
+#define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
+  OPTIONAL(tag, DwarfTagField, (dwarf::DW_TAG_array_type));                    \
+  OPTIONAL(name, MDStringField, );                                             \
+  OPTIONAL(file, MDField, );                                                   \
+  OPTIONAL(line, LineField, );                                                 \
+  OPTIONAL(scope, MDField, );                                                  \
+  OPTIONAL(baseType, MDField, );                                               \
+  OPTIONAL(size, MDUnsignedField, (0, UINT64_MAX));                            \
+  OPTIONAL(align, MDUnsignedField, (0, UINT32_MAX));                           \
+  OPTIONAL(offset, MDUnsignedField, (0, UINT64_MAX));                          \
+  OPTIONAL(flags, DIFlagField, );                                              \
+  OPTIONAL(elements, MDField, );
+  PARSE_MD_FIELDS();
+#undef VISIT_MD_FIELDS
+
+  // Create a new node, and save it in the context if it belongs in the type
+  // map.
+  Result = GET_OR_DISTINCT(
+      DIFortranArrayType,
+      (Context, tag.Val, name.Val, file.Val, line.Val, scope.Val, baseType.Val,
+       size.Val, align.Val, offset.Val, flags.Val, elements.Val));
+  return false;
+}
+
 bool LLParser::ParseDISubroutineType(MDNode *&Result, bool IsDistinct) {
 #define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
   OPTIONAL(flags, DIFlagField, );                                              \

lib/Bitcode/Reader/MetadataLoader.cpp

       case bitc::METADATA_LOCATION:
       case bitc::METADATA_GENERIC_DEBUG:
       case bitc::METADATA_SUBRANGE:
+      case bitc::METADATA_FORTRAN_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_FORTRAN_ARRAY_TYPE:
       case bitc::METADATA_SUBROUTINE_TYPE:
       case bitc::METADATA_MODULE:
       case bitc::METADATA_FILE:

     NextMetadataNo++;
     break;
   }
+  case bitc::METADATA_FORTRAN_SUBRANGE: {
+    if (Record.size() != 8)
+      return error("Invalid record");
+
+    IsDistinct = Record[0];
+    MetadataList.assignValue(
+        GET_OR_DISTINCT(DIFortranSubrange,
+                        (Context, Record[1], Record[2], Record[3],
+                         getMDOrNull(Record[4]), getMDOrNull(Record[5]),
+                         getMDOrNull(Record[6]), getMDOrNull(Record[7]))),
+        NextMetadataNo);
+    NextMetadataNo++;
+    break;
+  }
   case bitc::METADATA_ENUMERATOR: {
     if (Record.size() != 3)
       return error("Invalid record");

     NextMetadataNo++;
     break;
   }
+  case bitc::METADATA_STRING_TYPE: {
+    if (Record.size() != 6)
+      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");

     NextMetadataNo++;
     break;
   }
+  case bitc::METADATA_FORTRAN_ARRAY_TYPE: {
+    if (Record.size() != 12)
+      return error("Invalid record");
+
+    // If we have a UUID and this is not a forward declaration, lookup the
+    // mapping.
+    IsDistinct = Record[0] & 0x1;
+    unsigned Tag = Record[1];
+    MDString *Name = getMDString(Record[2]);
+    Metadata *File = getMDOrNull(Record[3]);
+    unsigned Line = Record[4];
+    Metadata *Scope = getDITypeRefOrNull(Record[5]);
+    Metadata *BaseType = nullptr;
+    uint64_t SizeInBits = Record[7];
+    if (Record[8] > (uint64_t)std::numeric_limits<uint32_t>::max())
+      return error("Alignment value is too large");
+    uint32_t AlignInBits = Record[8];
+    uint64_t OffsetInBits = 0;
+    DINode::DIFlags Flags = static_cast<DINode::DIFlags>(Record[10]);
+    Metadata *Elements = nullptr;
+    BaseType = getDITypeRefOrNull(Record[6]);
+    OffsetInBits = Record[9];
+    Elements = getMDOrNull(Record[11]);
+    DIFortranArrayType *CT =
+      GET_OR_DISTINCT(DIFortranArrayType,
+                      (Context, Tag, Name, File, Line, Scope, BaseType,
+                       SizeInBits, AlignInBits, OffsetInBits, Flags,
+                       Elements));
+    MetadataList.assignValue(CT, NextMetadataNo);
+    NextMetadataNo++;
+    break;
+  }
   case bitc::METADATA_SUBROUTINE_TYPE: {
     if (Record.size() < 3 || Record.size() > 4)
       return error("Invalid record");

lib/Bitcode/Writer/BitcodeWriter.cpp

                           SmallVectorImpl<uint64_t> &Record, unsigned &Abbrev);
   void writeDISubrange(const DISubrange *N, SmallVectorImpl<uint64_t> &Record,
                        unsigned Abbrev);
+  void writeDIFortranSubrange(const DIFortranSubrange *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 writeDIFortranArrayType(const DIFortranArrayType *N,
+                               SmallVectorImpl<uint64_t> &Record,
+                               unsigned Abbrev);
   void writeDISubroutineType(const DISubroutineType *N,
                              SmallVectorImpl<uint64_t> &Record,
                              unsigned Abbrev);

   Record.clear();
 }
 
+void ModuleBitcodeWriter::writeDIFortranSubrange(
+    const DIFortranSubrange *N, SmallVectorImpl<uint64_t> &Record,
+    unsigned Abbrev) {
+  Record.push_back(N->isDistinct());
+  Record.push_back(N->getCLowerBound());
+  Record.push_back(N->getCUpperBound());
+  Record.push_back(N->noUpperBound());
+  Record.push_back(VE.getMetadataOrNullID(N->getLowerBound()));
+  Record.push_back(VE.getMetadataOrNullID(N->getLowerBoundExp()));
+  Record.push_back(VE.getMetadataOrNullID(N->getUpperBound()));
+  Record.push_back(VE.getMetadataOrNullID(N->getUpperBoundExp()));
+
+  Stream.EmitRecord(bitc::METADATA_FORTRAN_SUBRANGE, Record, Abbrev);
+  Record.clear();
+}
+
 void ModuleBitcodeWriter::writeDIEnumerator(const DIEnumerator *N,
                                             SmallVectorImpl<uint64_t> &Record,
                                             unsigned 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.clear();
 }
 
+void ModuleBitcodeWriter::writeDIFortranArrayType(
+    const DIFortranArrayType *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());
+  Record.push_back(VE.getMetadataOrNullID(N->getScope()));
+  Record.push_back(VE.getMetadataOrNullID(N->getBaseType()));
+  Record.push_back(N->getSizeInBits());
+  Record.push_back(N->getAlignInBits());
+  Record.push_back(N->getOffsetInBits());
+  Record.push_back(N->getFlags());
+  Record.push_back(VE.getMetadataOrNullID(N->getElements().get()));
+
+  Stream.EmitRecord(bitc::METADATA_FORTRAN_ARRAY_TYPE, Record, Abbrev);
+  Record.clear();
+}
+
 void ModuleBitcodeWriter::writeDISubroutineType(
     const DISubroutineType *N, SmallVectorImpl<uint64_t> &Record,
     unsigned Abbrev) {

lib/CodeGen/AsmPrinter/DebugLocEntry.h

   /// \brief Lower this entry into a DWARF expression.
   void finalize(const AsmPrinter &AP, DebugLocStream::ListBuilder &List,
                 const DIBasicType *BT);
+
+  void finalize(const AsmPrinter &AP, DebugLocStream::ListBuilder &List,
+                const DIStringType *ST);
 };
 
 /// \brief Compare two Values for equality.

lib/CodeGen/AsmPrinter/DebugLocStream.h

   DbgVariable &V;
   const MachineInstr &MI;
   size_t ListIndex;
+  bool Finalized;
 
 public:
   ListBuilder(DebugLocStream &Locs, DwarfCompileUnit &CU, AsmPrinter &Asm,
               DbgVariable &V, const MachineInstr &MI)
-      : Locs(Locs), Asm(Asm), V(V), MI(MI), ListIndex(Locs.startList(&CU)) {}
+      : Locs(Locs), Asm(Asm), V(V), MI(MI), ListIndex(Locs.startList(&CU)),
+        Finalized(false) {}
+
+  void finalize();
 
   /// Finalize the list.
   ///
   /// If the list is empty, delete it.  Otherwise, finalize it by creating a
   /// temp symbol in \a Asm and setting up the \a DbgVariable.
-  ~ListBuilder();
+  ~ListBuilder() { finalize(); }
 
   DebugLocStream &getLocs() { return Locs; }
 };

lib/CodeGen/AsmPrinter/DebugLocStream.cpp

          "Popped off more entries than are in the list");
 }
 
-DebugLocStream::ListBuilder::~ListBuilder() {
+void DebugLocStream::ListBuilder::finalize() {
+  if (Finalized)
+    return;
+  Finalized = true;
   if (!Locs.finalizeList(Asm))
     return;
   V.initializeDbgValue(&MI);

lib/CodeGen/AsmPrinter/DwarfCompileUnit.h

   void setBaseAddress(const MCSymbol *Base) { BaseAddress = Base; }
   const MCSymbol *getBaseAddress() const { return BaseAddress; }
 
+  void constructDieLocation(DIE &Die, dwarf::Attribute Attribute,
+                            const DbgVariable &DV);
+  void constructDieLocationAddExpr(DIE &Die, dwarf::Attribute Attribute,
+                                   const DbgVariable &DV,
+                                   DIExpression *SubExpr);
+
   bool hasDwarfPubSections() const;
 };
 

lib/CodeGen/AsmPrinter/DwarfCompileUnit.cpp

   }
 
   // Add variable address.
+  constructDieLocation(*VariableDie, dwarf::DW_AT_location, DV);
+  return VariableDie;
+}
 
-  unsigned Offset = DV.getDebugLocListIndex();
-  if (Offset != ~0U) {
-    addLocationList(*VariableDie, dwarf::DW_AT_location, Offset);
-    return VariableDie;
+void DwarfCompileUnit::constructDieLocation(
+    DIE &Die, dwarf::Attribute Attribute, const DbgVariable &DV) {
+  if (Attribute == dwarf::DW_AT_location) {
+    unsigned Offset = DV.getDebugLocListIndex();
+    if (Offset != ~0U) {
+      addLocationList(Die, Attribute, Offset);
+      return;
+    }
   }
 
   // Check if variable is described by a DBG_VALUE instruction.

       // If the second operand is an immediate, this is an indirect value.
       assert((!Op1.isImm() || (Op1.getImm() == 0)) && "unexpected offset");
       MachineLocation Location(RegOp.getReg(), Op1.isImm());
-      addVariableAddress(DV, *VariableDie, Location);
+      addVariableAddress(DV, Die, Location);
     } else if (DVInsn->getOperand(0).isImm()) {
       // This variable is described by a single constant.
       // Check whether it has a DIExpression.

         DwarfExpr.addFragmentOffset(Expr);
         DwarfExpr.addUnsignedConstant(DVInsn->getOperand(0).getImm());
         DwarfExpr.addExpression(Expr);
-        addBlock(*VariableDie, dwarf::DW_AT_location, DwarfExpr.finalize());
+        addBlock(Die, Attribute, DwarfExpr.finalize());
       } else
-        addConstantValue(*VariableDie, DVInsn->getOperand(0), DV.getType());
+        addConstantValue(Die, DVInsn->getOperand(0), DV.getType());
     } else if (DVInsn->getOperand(0).isFPImm())
-      addConstantFPValue(*VariableDie, DVInsn->getOperand(0));
+      addConstantFPValue(Die, DVInsn->getOperand(0));
     else if (DVInsn->getOperand(0).isCImm())
-      addConstantValue(*VariableDie, DVInsn->getOperand(0).getCImm(),
+      addConstantValue(Die, DVInsn->getOperand(0).getCImm(),
                        DV.getType());
 
-    return VariableDie;
+    return;
   }
 
   // .. else use frame index.
   if (!DV.hasFrameIndexExprs())
-    return VariableDie;
+    return;
 
   DIELoc *Loc = new (DIEValueAllocator) DIELoc;
   DIEDwarfExpression DwarfExpr(*Asm, *this, *Loc);

         *Asm->MF->getSubtarget().getRegisterInfo(), Cursor, FrameReg);
     DwarfExpr.addExpression(std::move(Cursor));
   }
-  addBlock(*VariableDie, dwarf::DW_AT_location, DwarfExpr.finalize());
+  addBlock(Die, Attribute, DwarfExpr.finalize());
+}
 
-  return VariableDie;
+void DwarfCompileUnit::constructDieLocationAddExpr(
+    DIE &Die, dwarf::Attribute Attribute, const DbgVariable &DV,
+    DIExpression *SubExpr) {
+  if (Attribute == dwarf::DW_AT_location)
+    return; // clients like gdb don't handle location lists correctly
+  if (DV.getMInsn())
+    return; // temp should not have a DBG_VALUE instruction
+  if (!DV.hasFrameIndexExprs())
+    return; // but it should have a frame index expression
+
+  DIELoc *Loc = new (DIEValueAllocator) DIELoc;
+  DIEDwarfExpression DwarfExpr(*Asm, *this, *Loc);
+  for (auto &Fragment : DV.getFrameIndexExprs()) {
+    unsigned FrameReg = 0;
+    const DIExpression *Expr = Fragment.Expr;
+    const TargetFrameLowering *TFI = Asm->MF->getSubtarget().getFrameLowering();
+    int Offset = TFI->getFrameIndexReference(*Asm->MF, Fragment.FI, FrameReg);
+    DwarfExpr.addFragmentOffset(Expr);
+    SmallVector<uint64_t, 8> Ops;
+    Ops.push_back(dwarf::DW_OP_plus_uconst);
+    Ops.push_back(Offset);
+    Ops.append(Expr->elements_begin(), Expr->elements_end());
+    if (SubExpr) {
+      for (unsigned SEOp : SubExpr->getElements())
+        Ops.push_back(SEOp);
+    } else {
+      Ops.push_back(dwarf::DW_OP_deref);
+    }
+    DIExpressionCursor Cursor(Ops);
+    DwarfExpr.setMemoryLocationKind();
+    DwarfExpr.addMachineRegExpression(
+        *Asm->MF->getSubtarget().getRegisterInfo(), Cursor, FrameReg);
+    DwarfExpr.addExpression(std::move(Cursor));
+  }
+  addBlock(Die, Attribute, DwarfExpr.finalize());
 }
 
 DIE *DwarfCompileUnit::constructVariableDIE(DbgVariable &DV,

lib/CodeGen/AsmPrinter/DwarfDebug.h

   DwarfCompileUnit *CU;
 };
 
+class DummyDwarfExpression;
+
 /// Collects and handles dwarf debug information.
 class DwarfDebug : public DebugHandlerBase {
   /// All DIEValues are allocated through this allocator.

   bool SingleCU;
   bool IsDarwin;
 
+  /// Map for tracking Fortran deferred CHARACTER lengths
+  DenseMap<const DIStringType*, unsigned> StringTypeLocMap;
+
+  /// Map for tracking Fortran assumed shape array descriptors
+  DenseMap<const DIFortranSubrange*, DIE*> SubrangeDieMap;
+
+  DenseMap<const DIVariable*,const DIType*> VariableInDependentType;
+
   AddressPool AddrPool;
 
   DwarfAccelTable AccelNames;

   void collectVariableInfoFromMFTable(DwarfCompileUnit &TheCU,
                                       DenseSet<InlinedVariable> &P);
 
+  /// Populate dependent type variable map
+  void populateDependentTypeMap();
+
+  /// Clear dependent type tracking map
+  void clearDependentTracking() { VariableInDependentType.clear(); }
+
 protected:
   /// Gather pre-function debug information.
   void beginFunctionImpl(const MachineFunction *MF) override;

   /// Find the matching DwarfCompileUnit for the given CU DIE.
   DwarfCompileUnit *lookupCU(const DIE *Die) { 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;
+  }
+
+  DIE *getSubrangeDie(const DIFortranSubrange *SR) const;
+  void constructSubrangeDie(const DIFortranArrayType *AT,
+                            DbgVariable &DV, DwarfCompileUnit &TheCU);
+
   /// \defgroup DebuggerTuning Predicates to tune DWARF for a given debugger.
   ///
   /// Returns whether we are "tuning" for a given debugger.

lib/CodeGen/AsmPrinter/DwarfDebug.cpp

     CU.createAbstractVariable(Cleansed, Scope);
 }
 
+DIE *DwarfDebug::getSubrangeDie(const DIFortranSubrange *SR) const {
+  auto I = SubrangeDieMap.find(SR);
+  return (I == SubrangeDieMap.end()) ? nullptr : I->second;
+}
+
+void DwarfDebug::constructSubrangeDie(const DIFortranArrayType *AT,
+                                      DbgVariable &DV,
+                                      DwarfCompileUnit &TheCU) {
+  dwarf::Attribute Attribute;
+  const DIFortranSubrange *WFS = nullptr;
+  DIExpression *WEx = nullptr;
+  const DIVariable *DI = DV.getVariable();
+  DINodeArray Elements = AT->getElements();
+
+  for (unsigned i = 0, N = Elements.size(); i < N; ++i) {
+    DINode *Element = cast<DINode>(Elements[i]);
+    if (const DIFortranSubrange *FS = dyn_cast<DIFortranSubrange>(Element)) {
+      if (DIVariable *UBV = FS->getUpperBound())
+        if (UBV == DI) {
+          Attribute = dwarf::DW_AT_upper_bound;
+          WFS = FS;
+          WEx = FS->getUpperBoundExp();
+          break;
+        }
+      if (DIVariable *LBV = FS->getLowerBound())
+        if (LBV == DI) {
+          Attribute = dwarf::DW_AT_lower_bound;
+          WFS = FS;
+          WEx = FS->getLowerBoundExp();
+          break;
+        }          
+    }
+  }
+
+  if (!WFS)
+    return;
+
+  DIE *Die;
+  auto I = SubrangeDieMap.find(WFS);
+  if (I == SubrangeDieMap.end()) {
+    Die = DIE::get(DIEValueAllocator, dwarf::DW_TAG_subrange_type);
+    SubrangeDieMap[WFS] = Die;
+  } else {
+    Die = I->second;
+  }
+
+  TheCU.constructDieLocationAddExpr(*Die, Attribute, DV, WEx);
+}
+
 // Collect variable information from side table maintained by MF.
 void DwarfDebug::collectVariableInfoFromMFTable(
     DwarfCompileUnit &TheCU, DenseSet<InlinedVariable> &Processed) {

     ensureAbstractVariableIsCreatedIfScoped(TheCU, Var, Scope->getScopeNode());
     auto RegVar = llvm::make_unique<DbgVariable>(Var.first, Var.second);
     RegVar->initializeMMI(VI.Expr, VI.Slot);
+    if (VariableInDependentType.count(VI.Var)) {
+      const DIType *DT = VariableInDependentType[VI.Var];
+      if (const DIFortranArrayType *AT = dyn_cast<DIFortranArrayType>(DT))
+        constructSubrangeDie(AT, *RegVar.get(), TheCU);
+    } 
     if (DbgVariable *DbgVar = MFVars.lookup(Var))
       DbgVar->addMMIEntry(*RegVar);
     else if (InfoHolder.addScopeVariable(Scope, RegVar.get())) {

   return false;
 }
 
+void DwarfDebug::populateDependentTypeMap() {
+  for (const auto &I : DbgValues) {
+    InlinedVariable IV = I.first;
+    if (I.second.empty())
+      continue;
+
+    if (const DIStringType *ST = dyn_cast<DIStringType>(
+            static_cast<const Metadata *>(IV.first->getType())))
+      if (const DIVariable *LV = ST->getStringLength())
+        VariableInDependentType[LV] = ST;
+
+    if (const DIFortranArrayType *AT = dyn_cast<DIFortranArrayType>(
+            static_cast<const Metadata *>(IV.first->getType())))
+      for (const DINode *S : AT->getElements())
+        if (const DIFortranSubrange *FS = dyn_cast<DIFortranSubrange>(S)) {
+          if (const DIVariable *LBV = FS->getLowerBound())
+            VariableInDependentType[LBV] = AT;
+          if (const DIVariable *UBV = FS->getUpperBound())
+            VariableInDependentType[UBV] = AT;
+        }
+  }
+}
+
 // Find variables for each lexical scope.
 void DwarfDebug::collectVariableInfo(DwarfCompileUnit &TheCU,
                                      const DISubprogram *SP,
                                      DenseSet<InlinedVariable> &Processed) {
+  clearDependentTracking();
+  populateDependentTypeMap();
   // Grab the variable info that was squirreled away in the MMI side-table.
   collectVariableInfoFromMFTable(TheCU, Processed);
 

     // Finalize the entry by lowering it into a DWARF bytestream.
     for (auto &Entry : Entries)
       Entry.finalize(*Asm, List, BT);
+    List.finalize();
+
+    if (VariableInDependentType.count(IV.first)) {
+      const DIType *DT = VariableInDependentType[IV.first];
+      if (const DIStringType *ST = dyn_cast<DIStringType>(DT)) {
+        unsigned Offset;
+        DbgVariable TVar = {IV.first, IV.second};
+        DebugLocStream::ListBuilder LB(DebugLocs, TheCU, *Asm, TVar, *MInsn);
+        for (auto &Entry : Entries)
+          Entry.finalize(*Asm, LB, ST);
+        LB.finalize();
+        Offset = TVar.getDebugLocListIndex();
+        if (Offset != ~0u)
+          addStringTypeLoc(ST, Offset);
+      }
+    }
   }
 
+
   // Collect info for variables that were optimized out.
   for (const DILocalVariable *DV : SP->getVariables()) {
     if (Processed.insert(InlinedVariable(DV, nullptr)).second)

   DwarfExpr.finalize();
 }
 
+void DebugLocEntry::finalize(const AsmPrinter &AP,
+                             DebugLocStream::ListBuilder &List,
+                             const DIStringType *ST) {
+  DebugLocStream::EntryBuilder Entry(List, Begin, End);
+  BufferByteStreamer Streamer = Entry.getStreamer();
+  DebugLocDwarfExpression DwarfExpr(AP.getDwarfVersion(), Streamer);
+  DebugLocEntry::Value Value = Values[0];
+  assert(!Value.isFragment());
+  assert(Values.size() == 1 && "only fragments may have >1 value");
+  Value.Expression = ST->getStringLengthExp();
+  emitDebugLocValue(AP, nullptr, Streamer, Value, DwarfExpr);
+  DwarfExpr.finalize();
+}
+
 void DwarfDebug::emitDebugLocEntryLocation(const DebugLocStream::Entry &Entry) {
   // Emit the size.
   Asm->OutStreamer->AddComment("Loc expr size");

lib/CodeGen/AsmPrinter/DwarfExpression.h

 
 /// DwarfExpression implementation for singular DW_AT_location.
 class DIEDwarfExpression final : public DwarfExpression {
   const AsmPrinter ≈
   DwarfUnit &DU;
   DIELoc ¨
 

lib/CodeGen/AsmPrinter/DwarfExpression.cpp

       emitOp(dwarf::DW_OP_plus_uconst);
       emitUnsigned(Op->getArg(0));
       break;
+    case dwarf::DW_OP_deref_size:
+      assert(LocationKind != Register);
+      emitOp(dwarf::DW_OP_deref_size);
+      emitUnsigned(Op->getArg(0));
+      break;
     case dwarf::DW_OP_plus:
     case dwarf::DW_OP_minus:
     case dwarf::DW_OP_mul:

lib/CodeGen/AsmPrinter/DwarfUnit.h

 
 private:
   void constructTypeDIE(DIE &Buffer, const DIBasicType *BTy);
+  void constructTypeDIE(DIE &Buffer, const DIStringType *BTy);
+  void constructTypeDIE(DIE &Buffer, const DIFortranArrayType *ATy);
   void constructTypeDIE(DIE &Buffer, const DIDerivedType *DTy);
   void constructTypeDIE(DIE &Buffer, const DISubroutineType *DTy);
   void constructSubrangeDIE(DIE &Buffer, const DISubrange *SR, DIE *IndexTy);
+  void constructFortranSubrangeDIE(DIE &Buffer, const DIFortranSubrange *SR);
   void constructArrayTypeDIE(DIE &Buffer, const DICompositeType *CTy);
+  void constructArrayTypeDIE(DIE &Buffer, const DIFortranArrayType *ATy);
   void constructEnumTypeDIE(DIE &Buffer, const DICompositeType *CTy);
   void constructMemberDIE(DIE &Buffer, const DIDerivedType *DT);
   void constructTemplateTypeParameterDIE(DIE &Buffer,

lib/CodeGen/AsmPrinter/DwarfUnit.cpp

 
   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 *ATy = dyn_cast<DIFortranArrayType>(Ty))
+    constructArrayTypeDIE(TyDIE, ATy);
   else if (auto *CTy = dyn_cast<DICompositeType>(Ty)) {
     if (GenerateDwarfTypeUnits && !Ty->isForwardDecl())
       if (MDString *TypeId = CTy->getRawIdentifier()) {

   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);
 }
 
+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 (unsigned LLI = DD->getStringTypeLoc(STy)) {
+    // DW_TAG_string_type has a DW_AT_string_length location
+    dwarf::Form Form = (DD->getDwarfVersion() >= 4)
+      ? dwarf::DW_FORM_sec_offset : dwarf::DW_FORM_data4;
+    Buffer.addValue(DIEValueAllocator, dwarf::DW_AT_string_length, Form,
+                    DIELocList(LLI));
+  }
+
+  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();

 
   if (SP->isMainSubprogram())
     addFlag(SPDie, dwarf::DW_AT_main_subprogram);
+  if (SP->isPure())
+    addFlag(SPDie, dwarf::DW_AT_pure);
+  if (SP->isElemental())
+    addFlag(SPDie, dwarf::DW_AT_elemental);
+  if (SP->isRecursive())
+    addFlag(SPDie, dwarf::DW_AT_recursive);
 }
 
 void DwarfUnit::constructSubrangeDIE(DIE &Buffer, const DISubrange *SR,

     addUInt(DW_Subrange, dwarf::DW_AT_count, None, Count);
 }
 
+void DwarfUnit::constructFortranSubrangeDIE(DIE &Buffer,
+                                            const DIFortranSubrange *SR) {
+  DIE *IndexTy = getIndexTyDie();
+  DIE *Die = DD->getSubrangeDie(SR);
+  if ((!Die) || Die->getParent())
+    Die = DIE::get(DIEValueAllocator, dwarf::DW_TAG_subrange_type);
+  DIE &DW_Subrange = Buffer.addChild(Die);
+  addDIEEntry(DW_Subrange, dwarf::DW_AT_type, *IndexTy);
+
+  if (!SR->getLowerBound()) {
+    int64_t BVC = SR->getCLowerBound();
+    addSInt(DW_Subrange, dwarf::DW_AT_lower_bound, None, BVC);
+  }
+
+  if ((!SR->getUpperBound()) && (!SR->noUpperBound())) {
+    int64_t BVC = SR->getCUpperBound();
+    addSInt(DW_Subrange, dwarf::DW_AT_upper_bound, None, BVC);
+  }
+}
+
 DIE *DwarfUnit::getIndexTyDie() {
   if (IndexTyDie)
     return IndexTyDie;

   }
 }
 
+void DwarfUnit::constructArrayTypeDIE(DIE &Buffer,
+                                      const DIFortranArrayType *ATy) {
+  // Emit the element type.
+  addType(Buffer, resolve(ATy->getBaseType()));
+
+  // Add subranges to array type.
+  DINodeArray Elements = ATy->getElements();
+  for (unsigned i = 0, N = Elements.size(); i < N; ++i) {
+    DINode *Element = cast<DINode>(Elements[i]);
+    if (const DIFortranSubrange *FS = dyn_cast<DIFortranSubrange>(Element))
+      constructFortranSubrangeDIE(Buffer, FS);
+  }
+}
+
 void DwarfUnit::constructEnumTypeDIE(DIE &Buffer, const DICompositeType *CTy) {
   DINodeArray Elements = CTy->getElements();
 

lib/IR/AsmWriter.cpp

   Out << ")";
 }
 
+static void writeDIFortranSubrange(raw_ostream &Out, const DIFortranSubrange *N,
+                                   TypePrinting *TypePrinter,
+                                   SlotTracker *Machine,
+                                   const Module *Context) {
+  Out << "!DIFortranSubrange(";
+  MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
+  Printer.printInt("constLowerBound", N->getCLowerBound(), false);
+  if (!N->noUpperBound())
+    Printer.printInt("constUpperBound", N->getCUpperBound(), false);
+  Printer.printMetadata("lowerBound", N->getRawLowerBound());
+  Printer.printMetadata("lowerBoundExpression",
+                        N->getRawLowerBoundExpression());
+  Printer.printMetadata("upperBound", N->getRawUpperBound());
+  Printer.printMetadata("upperBoundExpression",
+                        N->getRawUpperBoundExpression());
+  Out << ")";
+}
+
 static void writeDIEnumerator(raw_ostream &Out, const DIEnumerator *N,
                               TypePrinting *, SlotTracker *, const Module *) {
   Out << "!DIEnumerator(";

   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 << ")";
 }
 
+static void writeDIFortranArrayType(
+    raw_ostream &Out, const DIFortranArrayType *N, TypePrinting *TypePrinter,
+    SlotTracker *Machine, const Module *Context) {
+  Out << "!DIFortranArrayType(";
+  MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
+  Printer.printTag(N);
+  Printer.printString("name", N->getName());
+  Printer.printMetadata("scope", N->getRawScope());
+  Printer.printMetadata("file", N->getRawFile());
+  Printer.printInt("line", N->getLine());
+  Printer.printMetadata("baseType", N->getRawBaseType());
+  Printer.printInt("size", N->getSizeInBits());
+  Printer.printInt("align", N->getAlignInBits());
+  Printer.printInt("offset", N->getOffsetInBits());
+  Printer.printDIFlags("flags", N->getFlags());
+  Printer.printMetadata("elements", N->getRawElements());
+  Out << ")";
+}
+
 static void writeDISubroutineType(raw_ostream &Out, const DISubroutineType *N,
                                   TypePrinting *TypePrinter,
                                   SlotTracker *Machine, const Module *Context) {

lib/IR/DIBuilder.cpp

                           0, Encoding);
 }
 
+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);

   return R;
 }
 
+DIFortranArrayType *DIBuilder::createFortranArrayType(
+    uint64_t Size, uint32_t AlignInBits, DIType *Ty, DINodeArray Subscripts) {
+  auto *R = DIFortranArrayType::get(VMContext, dwarf::DW_TAG_array_type, "",
+                                    nullptr, 0, nullptr, Ty, Size, AlignInBits,
+                                    0, DINode::FlagZero, Subscripts);
+  trackIfUnresolved(R);
+  return R;
+}
+
 DICompositeType *DIBuilder::createVectorType(uint64_t Size,
                                              uint32_t AlignInBits, DIType *Ty,
                                              DINodeArray Subscripts) {

   return DISubrange::get(VMContext, Count, Lo);
 }
 
+DIFortranSubrange *DIBuilder::getOrCreateFortranSubrange(
+    int64_t CLB, int64_t CUB, bool NUB, Metadata *LB, Metadata *LBE,
+    Metadata *UB, Metadata *UBE) {
+  return DIFortranSubrange::get(VMContext, CLB, CUB, NUB, LB, LBE, UB, UBE);
+}
+
 static void checkGlobalVariableScope(DIScope *Context) {
 #ifndef NDEBUG
   if (auto *CT =

lib/IR/DebugInfoMetadata.cpp

   DEFINE_GETIMPL_STORE_NO_OPS(DISubrange, (Count, Lo));
 }
 
+DIFortranSubrange *DIFortranSubrange::getImpl(
+    LLVMContext &Context, int64_t CLB, int64_t CUB, bool NUB, Metadata *LB,
+    Metadata *LBE, Metadata *UB, Metadata *UBE, StorageType Storage,
+    bool ShouldCreate) {
+  DEFINE_GETIMPL_LOOKUP(DIFortranSubrange, (CLB, CUB, NUB, LB, LBE, UB, UBE));
+  Metadata *Ops[] = {LB, LBE, UB, UBE};
+  DEFINE_GETIMPL_STORE(DIFortranSubrange, (CLB, CUB, NUB), Ops);
+}
+
 DIEnumerator *DIEnumerator::getImpl(LLVMContext &Context, int64_t Value,
                                     MDString *Name, StorageType Storage,
                                     bool ShouldCreate) {

                        Ops);
 }
 
+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,

                        Ops);
 }
 
+DIFortranArrayType *DIFortranArrayType::getImpl(
+    LLVMContext &Context, unsigned Tag, MDString *Name, Metadata *File,
+    unsigned Line, Metadata *Scope, Metadata *BaseType, uint64_t SizeInBits,
+    uint32_t AlignInBits, uint64_t OffsetInBits, DIFlags Flags,
+    Metadata *Elements, StorageType Storage, bool ShouldCreate) {
+  assert(isCanonical(Name) && "Expected canonical MDString");
+
+  // Keep this in sync with buildODRType.
+  DEFINE_GETIMPL_LOOKUP(
+      DIFortranArrayType, (Tag, Name, File, Line, Scope, BaseType, SizeInBits,
+                           AlignInBits, OffsetInBits, Flags, Elements));
+  Metadata *Ops[] = {File, Scope, Name, BaseType, Elements};
+  DEFINE_GETIMPL_STORE(DIFortranArrayType, (Tag, Line, SizeInBits, AlignInBits,
+                                            OffsetInBits, Flags), Ops);
+}
+
 DICompositeType *DICompositeType::buildODRType(
     LLVMContext &Context, MDString &Identifier, unsigned Tag, MDString *Name,
     Metadata *File, unsigned Line, Metadata *Scope, Metadata *BaseType,

     return 3;
   case dwarf::DW_OP_constu:
   case dwarf::DW_OP_plus_uconst:
+  case dwarf::DW_OP_deref_size:
     return 2;
   default:
     return 1;

     case dwarf::DW_OP_mul:
     case dwarf::DW_OP_deref:
     case dwarf::DW_OP_xderef:
+    case dwarf::DW_OP_deref_size:
       break;
     }
   }

lib/IR/LLVMContextImpl.h

   unsigned getHashValue() const { return hash_combine(Count, LowerBound); }
 };
 
+template <> struct MDNodeKeyImpl<DIFortranSubrange> {
+  int64_t CLBound;
+  int64_t CUBound;
+  bool NoUBound;
+  Metadata *LowerBound;
+  Metadata *LowerBoundExp;
+  Metadata *UpperBound;
+  Metadata *UpperBoundExp;
+
+  MDNodeKeyImpl(int64_t CLB, int64_t CUB, bool NUB, Metadata *LB, Metadata *LBE,
+                Metadata *UB, Metadata *UBE)
+      : CLBound(CLB), CUBound(CUB), NoUBound(NUB), LowerBound(LB),
+        LowerBoundExp(LBE), UpperBound(UB), UpperBoundExp(UBE) {}
+  MDNodeKeyImpl(const DIFortranSubrange *N)
+      : CLBound(N->getCLowerBound()), CUBound(N->getCUpperBound()),
+        NoUBound(N->noUpperBound()), LowerBound(N->getRawLowerBound()),
+        LowerBoundExp(N->getRawLowerBoundExpression()),
+        UpperBound(N->getRawUpperBound()),
+        UpperBoundExp(N->getRawUpperBoundExpression()) {}
+
+  bool isKeyOf(const DIFortranSubrange *RHS) const {
+    return CLBound == RHS->getCLowerBound() &&
+      CUBound == RHS->getCUpperBound() &&
+      NoUBound == RHS->noUpperBound() &&
+      LowerBound == RHS->getRawLowerBound() &&
+      LowerBoundExp == RHS->getRawLowerBoundExpression() &&
+      UpperBound == RHS->getRawUpperBound() &&
+      UpperBoundExp == RHS->getRawUpperBoundExpression();
+  }
+
+  unsigned getHashValue() const {
+    return hash_combine(CLBound, CUBound, NoUBound, UpperBound, UpperBoundExp,
+                        LowerBound, LowerBoundExp);
+  }
+};
+
 template <> struct MDNodeKeyImpl<DIEnumerator> {
   int64_t Value;
   MDString *Name;

   }
 };
 
+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, SizeInBits, AlignInBits, Encoding);
+  }
+};
+
 template <> struct MDNodeKeyImpl<DIDerivedType> {
   unsigned Tag;
   MDString *Name;

   }
 };
 
+template <> struct MDNodeKeyImpl<DIFortranArrayType> {
+  unsigned Tag;
+  MDString *Name;
+  Metadata *File;
+  unsigned Line;
+  Metadata *Scope;
+  Metadata *BaseType;
+  uint64_t SizeInBits;
+  uint64_t OffsetInBits;
+  uint32_t AlignInBits;
+  unsigned Flags;
+  Metadata *Elements;
+
+  MDNodeKeyImpl(unsigned Tag, MDString *Name, Metadata *File, unsigned Line,
+                Metadata *Scope, Metadata *BaseType, uint64_t SizeInBits,
+                uint32_t AlignInBits, uint64_t OffsetInBits, unsigned Flags,
+                Metadata *Elements)
+      : Tag(Tag), Name(Name), File(File), Line(Line), Scope(Scope),
+        BaseType(BaseType), SizeInBits(SizeInBits), OffsetInBits(OffsetInBits),
+        AlignInBits(AlignInBits), Flags(Flags), Elements(Elements) {}
+  MDNodeKeyImpl(const DIFortranArrayType *N)
+      : Tag(N->getTag()), Name(N->getRawName()), File(N->getRawFile()),
+        Line(N->getLine()), Scope(N->getRawScope()),
+        BaseType(N->getRawBaseType()), SizeInBits(N->getSizeInBits()),
+        OffsetInBits(N->getOffsetInBits()), AlignInBits(N->getAlignInBits()),
+        Flags(N->getFlags()), Elements(N->getRawElements()) {}
+
+  bool isKeyOf(const DIFortranArrayType *RHS) const {
+    return Tag == RHS->getTag() && Name == RHS->getRawName() &&
+           File == RHS->getRawFile() && Line == RHS->getLine() &&
+           Scope == RHS->getRawScope() && BaseType == RHS->getRawBaseType() &&
+           SizeInBits == RHS->getSizeInBits() &&
+           AlignInBits == RHS->getAlignInBits() &&
+           OffsetInBits == RHS->getOffsetInBits() && Flags == RHS->getFlags() &&
+           Elements == RHS->getRawElements();
+  }
+
+  unsigned getHashValue() const {
+    // Intentionally computes the hash on a subset of the operands for
+    // performance reason. The subset has to be significant enough to avoid
+    // collision "most of the time". There is no correctness issue in case of
+    // collision because of the full check above.
+    return hash_combine(Name, File, Line, BaseType, Scope, Elements);
+  }
+};
+
 template <> struct MDNodeKeyImpl<DISubroutineType> {
   unsigned Flags;
   uint8_t CC;

lib/IR/Verifier.cpp

   AssertDI(N.getCount() >= -1, "invalid subrange count", &N);
 }
 
+void Verifier::visitDIFortranSubrange(const DIFortranSubrange &N) {
+  AssertDI(N.getTag() == dwarf::DW_TAG_subrange_type, "invalid tag", &N);
+  AssertDI(N.getLowerBound() ? (N.getLowerBoundExp() != nullptr) : true,
+           "no lower bound", &N);
+  AssertDI(N.getUpperBound() ? (N.getUpperBoundExp() != nullptr) : true,
+           "no upper bound", &N);
+}
+
 void Verifier::visitDIEnumerator(const DIEnumerator &N) {
   AssertDI(N.getTag() == dwarf::DW_TAG_enumerator, "invalid tag", &N);
 }

            "invalid tag", &N);
 }
 
+void Verifier::visitDIStringType(const DIStringType &N) {
+  AssertDI( N.getTag() == dwarf::DW_TAG_string_type,
+           "invalid tag", &N);
+}
+
 void Verifier::visitDIDerivedType(const DIDerivedType &N) {
   // Common scope checks.
   visitDIScope(N);

   }
 }
 
+void Verifier::visitDIFortranArrayType(const DIFortranArrayType &N) {
+  // Common scope checks.
+  visitDIScope(N);
+
+  AssertDI(N.getTag() == dwarf::DW_TAG_array_type, "invalid tag", &N);
+
+  AssertDI(isScope(N.getRawScope()), "invalid scope", &N, N.getRawScope());
+  AssertDI(isType(N.getRawBaseType()), "invalid base type", &N,
+           N.getRawBaseType());
+
+  AssertDI(!N.getRawElements() || isa<MDTuple>(N.getRawElements()),
+           "invalid composite elements", &N, N.getRawElements());
+  AssertDI(!hasConflictingReferenceFlags(N.getFlags()),
+           "invalid reference flags", &N);
+}
+
 void Verifier::visitDISubroutineType(const DISubroutineType &N) {
   AssertDI(N.getTag() == dwarf::DW_TAG_subroutine_type, "invalid tag", &N);
   if (auto *Types = N.getRawTypeArray()) {