Adding debug info to support Fortran (part 2)

[schweitz]

Summary

2. Fortran Type Support

2.1 CHARACTER Intrinsic Type
There is no analog in C for the Fortran CHARACTER type. The Fortran CHARACTER type maps to the DWARF tag, DW_TAG_string_type. We have added a new named DI to LLVM to generate this DWARF information.
!21 = !DIStringType(name: “character(5)”, size: 40)

This produces the following DWARF information.
DW_TAG_string_type:

DW_AT_name: “character(5)”
DW_AT_byte_size: 5

CHARACTER types can also have deferred length. This is supported in the new metadata as follows.
!22 = !DIStringType(name: “character(*)!1”, size: 32, stringLength: !23, stringLengthExpression: !DIExpression())
!23 = !DILocalVariable(scope: !3, arg: 4, file: !4, type: !5, flags: DIFlagArtificial)

This will generate the following DWARF information.
DW_TAG_string_type:

DW_AT_name: character(*)!1

DW_AT_string_length: 0x9b (location list)
DW_AT_byte_size: 4

2.2 Fortran Array Types and Bounds
In this section we refer to the DWARF tag, DW_TAG_array_type, which is used to describe Fortran arrays.
However in Fortran, arrays are not types but are rather runtime data objects, a multidimensional rectangular set of scalar data of homogeneous type. An array object has dimensions (rank and corank) and extents in those dimensions. The rank and ranges of the extents of an array may not be known until runtime. Arrays may be reshaped, acted upon in whole or in part, or otherwise be referenced (perhaps even in reverse order) non-contiguously. Furthermore arrays may be allocated and deallocated at runtime and aliased through other POINTER objects. In short, Fortran array objects are not readily mappable to the C family of languages model of arrays, and more expressive DWARF information is required.
2.2.1 Explicit array dimensions
An array may be given a constant size as in the following example. The example shows a two-dimensional array, named array, that has indices from 1 to 10 for the rows and 2 to 11 for the columns.
TYPE(t) :: array(10,2:11)

For this declaration, the compiler generates the following LLVM metadata.
!100 = !DIFortranArrayType(baseType: !7, elements: !101)
!101 = !{ !102, !103 }
!102 = !DIFortranSubrange(constLowerBound: 1, constUpperBound: 10)
!103 = !DIFortranSubrange(constLowerBound: 2, constUpperBound: 11)

The DWARF generated for this is as follows. (DWARF asserts in the standard that arrays are interpreted as column-major.)
DW_TAG_array_type:

DW_AT_name: array
DW_AT_type: 4d08 ;TYPE(t)

DW_TAG_subrange_type:
DW_AT_type: int
DW_AT_lower_bound: 1
DW_AT_upper_bound: 10
DW_TAG_subrange_type:
DW_AT_type: int
DW_AT_lower_bound: 2
DW_AT_upper_bound: 11

2.2.2 Adjustable arrays
By adjustable arrays, we mean that an array may have its size passed explicitly as another argument.
SUBROUTINE subr2(array2,N)

INTEGER :: N

TYPE(t) :: array2(N)

In this case, the compiler expresses the !DISubrange as an expression that references the dummy argument, N.
call void @llvm.dbg.declare(metadata i64* %N, metadata !113, metadata !DIExpression())
…
!110 = !DIFortranArrayType(baseType: !7, elements: !111)
!111 = !{ !112 }
!112 = !DIFortranSubrange(lowerBound: 1, upperBound: !113, upperBoundExpression: !DIExpression(DW_OP_deref))
!113 = !DILocalVariable(scope: !2, name: “zb1”, file: !3, type: !4, flags: DIFlagArtificial)

It turned out that gdb didn’t properly interpret location lists or variable references in the DW_AT_lower_bound and DW_AT_upper_bound attribute forms, so the compiler must generate either a constant or a block with the DW_OP operations for each of them.
DW_TAG_array_type:

DW_AT_name: array2
DW_AT_type: 4d08 ;TYPE(t)

DW_TAG_subrange_type:
DW_AT_type: int
DW_AT_lower_bound: 1
DW_AT_upper_bound: 2 byte block: 91 70

2.2.3 Assumed size arrays
An assumed size array leaves the last dimension of the array unspecified.
SUBROUTINE subr3(array3)

TYPE(t) :: array3(*)

The compiler generates DWARF information without an upper bound, such as in this snippet.
DW_TAG_array_type
DW_AT_name: array3
DW_TAG_subrange_type
DW_AT_type = int
DW_AT_lower_bound = 1

This DWARF is produced by omission of the upper bound information.
!122 = !DIFortranSubrange(lowerBound: 1)

2.2.4 Assumed shape arrays
Fortran also has assumed shape arrays, which allow extra state to be passed into the procedure to describe the shape of the array dummy argument. This extra information is the array descriptor, generated by the compiler, and passed as a hidden argument.
SUBROUTINE subr4(array4)

TYPE(t) :: array4(:,:)

In this case, the compiler generates DWARF expressions to access the results of the procedure’s usage of the array descriptor argument when it computes the lower bound (DW_AT_lower_bound) and upper bound (DW_AT_upper_bound).
…
call void @llvm.dbg.declare(metadata i64* %4, metadata !134, metadata !DIExpression())
call void @llvm.dbg.declare(metadata i64* %8, metadata !136, metadata !DIExpression())
call void @llvm.dbg.declare(metadata i64* %9, metadata !137, metadata !DIExpression())
call void @llvm.dbg.declare(metadata i64* %13, metadata !139, metadata !DIExpression())
…
!130 = !DIFortranArrayType(baseType: !80, elements: !131)
!131 = !{ !132, !133 }
!132 = !DISubrange(lowerBound: !134, lowerBoundExpression: !DIExpression(DW_OP_deref), upperBound: !136, upperBoundExpression: !DIExpression(DW_OP_deref))
!133 = !DISubrange(lowerBound: !137, lowerBoundExpression: !DIExpression(DW_OP_deref), upperBound: !139, upperBoundExpression: !DIExpression(DW_OP_deref))
!134 = !DILocalVariable(scope: !2, file: !3, type: !9, flags: DIArtificial)
!136 = !DILocalVariable(scope: !2, file: !3, type: !9, flags: DIArtificial)
!137 = !DILocalVariable(scope: !2, file: !3, type: !9, flags: DIArtificial)
!139 = !DILocalVariable(scope: !2, file: !3, type: !9, flags: DIArtificial)

The DWARF generated for this is as follows.
DW_TAG_array_type:
DW_AT_name: array4
DW_AT_type: 4d08 ;TYPE(t)
DW_TAG_subrange_type:
DW_AT_type: int
DW_AT_lower_bound: 2 byte block: 91 78
DW_AT_upper_bound: 2 byte block: 91 70
DW_TAG_subrange_type:
DW_AT_type: int
DW_AT_lower_bound: 2 byte block: 91 68
DW_AT_upper_bound: 2 byte block: 91 60

2.2.5 Assumed rank arrays and coarrays
This changeset does not address DWARF 5 extensions to support assumed rank arrays or coarrays.

[greened]

I'm not a Fortran expert. The last Fortran I used was 77 and didn't have all these newfangled features. :) Some questions come up on our end so I'll relay them.

Does this support handle non-contiguous arrays? Arrays can have "holes" in them. I believe the dope vectors ("array descriptors") hold that information but the description makes it sound like only upper and lower bounds are supported.

Fortran CHARACTER can have multi-byte characters so "byte size" is not sufficient. I don't know if any implementations support this, though.

[JohnReagan]

As I commented in the dev email list, these "Fortran" features are actually useful for other languages. We use similar DWARF for Pascal "schema types", BASIC string types, etc. on OpenVMS Itanium and we'll want to leverage all of these for our x86 target. I suggested that the names be make more neutral or folded into the matching metadata tag. I'll give inline comments next.

[JohnReagan]

include/llvm/IR/DIBuilder.h

491

So what's the difference here between createArrayType and createFortranArrayType? They both take subranges for subscripts, yes? The size would be a run-time value if any of the subranges have non-constant values but your createFortranArrayType handles that case and can be folded in.

582

Why not

getOrCreateSubrangeWithCount(Metadata *Lo, Metadata *CountNode);
getOrCreateSubrangeWithUpper(Metadata *Lo, Metadata *Up);

or something like this? I can imagine where the Upper value is easier to describe than the Count. On VMS, our array descriptors have bounds information inside of them so the Lo/Up values are just "descriptor-base + offset". Trying to describe the count would involve generating code into a temp variable or using a more complex DWARF expression to fetch the Lo and Up and doing the arithmetic that way.

And your comments don't describe the arguments so perhaps I'm missing something.

[aprantl]

Thanks. I have a couple of high-level points before we can go into more specific details:

The LLVM IR debug info metadata is effectively DWARF with a different syntax. Why is a Fortran-specific array / bounds node necessary oruseful, when DWARF doesn't have one?

DISubrange is the wrong place to hold a DIExpression; this won't work with optimized code. Instead, there should be a DIFlagArtificial variable for the lower and upper bound that is described with a llvm.dbg.value / llvm.dbg.declare and the dbg.value/declare should reference the DIExpression. This way the expression can be updated when the code is transformed by the optimizer.

[schweitz]

In D54114#1287650, @greened wrote:

I'm not a Fortran expert. The last Fortran I used was 77 and didn't have all these newfangled features. :) Some questions come up on our end so I'll relay them.

Does this support handle non-contiguous arrays? Arrays can have "holes" in them. I believe the dope vectors ("array descriptors") hold that information but the description makes it sound like only upper and lower bounds are supported.

This patch does not handle strided accesses.

Fortran CHARACTER can have multi-byte characters so "byte size" is not sufficient. I don't know if any implementations support this, though.

We don't know of any implementations either.

[schweitz]

In D54114#1287783, @JohnReagan wrote:

As I commented in the dev email list, these "Fortran" features are actually useful for other languages. We use similar DWARF for Pascal "schema types", BASIC string types, etc. on OpenVMS Itanium and we'll want to leverage all of these for our x86 target. I suggested that the names be make more neutral or folded into the matching metadata tag. I'll give inline comments next.

It may be possible to merge the C-language metadata with the Fortran metadata. It just wasn't our objective. It has been more helpful to keep them distinct.

[schweitz]

include/llvm/IR/DIBuilder.h

491

We've been propagating changes to LLVM for Fortran compilers for many LLVM releases now off-stream. There are a number of reasons why it was easier to make a "higher level" break like this. If these changes can be successfully upstreamed, then many of those arguments become historical.

582

I think the information in the summary section shows some of the details concerning the properties our Fortran compilers need. Specifically, both a lower bound and an upper bound, either of which can be constant or computed from a dope vector or omitted iff it is an upper bound in the right-most rank.

Our compilers don't use count (extent) to imply an upper bound.

[JohnReagan]

[Sorry for the delay, my Dad broke a hip and I had to travel to Tennessee.]

Our dope vectors (descriptors) have a lower/upper/stride per dimension to handle non-contiguous array. We haven't used multipliers since the VAX days. I think we need to set the byte_stride via some artificial variable (or just a field from the dope vector). Did I miss that?

[schweitz]

Thank you for your patience regarding the protracted schedule here. We're presently reworking some of the support for Fortran debug with respect to type information.

[probinson]

Sorry for being late to the party... I'm probably repeating some other comments but wanted to get these thoughts down.
Existing DI should handle an array with compile-time-constant bounds, so would not need anything new.
Variable-bound arrays are available in a variety of languages, not excepting C (VLAs). Again I'd have thought that existing DI would be able to handle this case, although I'm less sure of that.
DWARF did add a bunch of stuff for the newer Fortran array features, I'll have to re-acquaint myself with those before commenting.

[schweitz]

This code has become very stale and we will have another go at this with flang development.

include/llvm-c/DebugInfo.h

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

include/llvm/Bitcode/LLVMBitCodes.h

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

include/llvm/IR/DIBuilder.h

public:
     /// \param Name        Type name.
     /// \param SizeInBits  Size of the type.
     /// \param Encoding    DWARF encoding code, e.g., dwarf::DW_ATE_float.
     /// \param Flags       Optional DWARF attributes, e.g., DW_AT_endianity.
     DIBasicType *createBasicType(StringRef Name, uint64_t SizeInBits,
                                  unsigned Encoding,
                                  DINode::DIFlags Flags = DINode::FlagZero);
 
+    /// Create debugging information entry for a string
+    /// type.
+    /// \param Name        Type name.
+    /// \param SizeInBits  Size of the type.
+    DIStringType *createStringType(StringRef Name, uint64_t SizeInBits);
+
     /// Create debugging information entry for a qualified
     /// type, e.g. 'const int'.
     /// \param Tag         Tag identifing type, e.g. dwarf::TAG_volatile_type
     /// \param FromTy      Base Type.
     DIDerivedType *createQualifiedType(unsigned Tag, DIType *FromTy);
 
     /// Create debugging information entry for a pointer.
     /// \param PointeeTy         Type pointed by this pointer.
public:
     /// Create debugging information entry for an array.
     /// \param Size         Array size.
     /// \param AlignInBits  Alignment.
     /// \param Ty           Element type.
     /// \param Subscripts   Subscripts.
     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.
     /// \param Ty           Element type.
     /// \param Subscripts   Subscripts.
     DICompositeType *createVectorType(uint64_t Size, uint32_t AlignInBits,
                                       DIType *Ty, DINodeArray Subscripts);
 
public:
     /// Get a DITypeRefArray, create one if required.
     DITypeRefArray getOrCreateTypeArray(ArrayRef<Metadata *> Elements);
 
     /// Create a descriptor for a value range.  This
     /// implicitly uniques the values returned.
     DISubrange *getOrCreateSubrange(int64_t Lo, int64_t Count);
     DISubrange *getOrCreateSubrange(int64_t Lo, Metadata *CountNode);
 
+    /// 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.
     /// \param LinkageName Mangled  name of the variable.
     /// \param File        File where this variable is defined.
     /// \param LineNo      Line number.
     /// \param Ty          Variable Type.
     /// \param isLocalToUnit Boolean flag indicate whether this variable is

include/llvm/IR/DebugInfoMetadata.h

static DIFlags splitFlags(DIFlags Flags,
                             SmallVectorImpl<DIFlags> &SplitFlags);
 
   static bool classof(const Metadata *MD) {
     switch (MD->getMetadataID()) {
     default:
       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:
     case DISubprogramKind:
     case DILexicalBlockKind:
     case DILexicalBlockFileKind:
     case DINamespaceKind:
     case DITemplateTypeParameterKind:
CountType getCount() const {
     return CountType();
   }
 
   static bool classof(const Metadata *MD) {
     return MD->getMetadataID() == DISubrangeKind;
   }
 };
 
+/// 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
 /// longer creates a type cycle.
 class DIEnumerator : public DINode {
   friend class LLVMContextImpl;
   friend class MDNode;
 
return isa<DIFile>(this) ? const_cast<DIScope *>(this)
                              : static_cast<Metadata *>(getOperand(0));
   }
 
   static bool classof(const Metadata *MD) {
     switch (MD->getMetadataID()) {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:
     case DISubprogramKind:
     case DILexicalBlockKind:
     case DILexicalBlockFileKind:
     case DINamespaceKind:
     case DIModuleKind:
public:
   bool isBigEndian() const { return getFlags() & FlagBigEndian; }
   bool isLittleEndian() const { return getFlags() & FlagLittleEndian; }
 
   static bool classof(const Metadata *MD) {
     switch (MD->getMetadataID()) {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
       return true;
     }
   }
 };
 
 /// Basic type, like 'int' or 'float'.
 ///
TempDIBasicType cloneImpl() const {
     return getTemporary(getContext(), getTag(), getName(), getSizeInBits(),
                         getAlignInBits(), getEncoding(), getFlags());
   }
 
 public:
   DEFINE_MDNODE_GET(DIBasicType, (unsigned Tag, StringRef Name),
                     (Tag, Name, 0, 0, 0, FlagZero))
   DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, StringRef Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0, FlagZero))
+  DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, MDString *Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0, FlagZero))
+  DEFINE_MDNODE_GET(DIBasicType,
                     (unsigned Tag, StringRef Name, uint64_t SizeInBits,
                      uint32_t AlignInBits, unsigned Encoding, DIFlags Flags),
                     (Tag, Name, SizeInBits, AlignInBits, Encoding, Flags))
   DEFINE_MDNODE_GET(DIBasicType,
                     (unsigned Tag, MDString *Name, uint64_t SizeInBits,
                      uint32_t AlignInBits, unsigned Encoding, DIFlags Flags),
                     (Tag, Name, SizeInBits, AlignInBits, Encoding, Flags))
 
   TempDIBasicType clone() const { return cloneImpl(); }
 
   unsigned getEncoding() const { return Encoding; }
 
   enum class Signedness { Signed, Unsigned };
 
   /// Return the signedness of this type, or None if this type is neither
   /// signed nor unsigned.
   Optional<Signedness> getSignedness() const;
 
   static bool classof(const Metadata *MD) {
     return MD->getMetadataID() == DIBasicTypeKind;
   }
 };
 
+/// String type, Fortran CHARACTER(n)
+class DIStringType : public DIType {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  unsigned Encoding;
+
+  DIStringType(LLVMContext &C, StorageType Storage, unsigned Tag,
+               uint64_t SizeInBits, uint32_t AlignInBits, unsigned Encoding,
+               ArrayRef<Metadata *> Ops)
+      : DIType(C, DIStringTypeKind, Storage, Tag, 0, SizeInBits, AlignInBits, 0,
+               FlagZero, Ops),
+        Encoding(Encoding) {}
+  ~DIStringType() = default;
+
+  static DIStringType *getImpl(LLVMContext &Context, unsigned Tag,
+                               StringRef Name, Metadata *StringLength,
+                               Metadata *StrLenExp, uint64_t SizeInBits,
+                               uint32_t AlignInBits, unsigned Encoding,
+                               StorageType Storage, bool ShouldCreate = true) {
+    return getImpl(Context, Tag, getCanonicalMDString(Context, Name),
+                   StringLength, StrLenExp, SizeInBits, AlignInBits, Encoding,
+                   Storage, ShouldCreate);
+  }
+  static DIStringType *getImpl(LLVMContext &Context, unsigned Tag,
+                               MDString *Name, Metadata *StringLength,
+                               Metadata *StrLenExp, uint64_t SizeInBits,
+                               uint32_t AlignInBits, unsigned Encoding,
+                               StorageType Storage, bool ShouldCreate = true);
+
+  TempDIStringType cloneImpl() const {
+    return getTemporary(getContext(), getTag(), 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
 /// class members.
 ///
 /// TODO: Split out members (inheritance, fields, methods, etc.).
 class DIDerivedType : public DIType {
   friend class LLVMContextImpl;
#endif
   }
   /// @}
 
   static bool classof(const Metadata *MD) {
     return MD->getMetadataID() == DICompositeTypeKind;
   }
 };
 
+/// 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.
 class DISubroutineType : public DIType {
   friend class LLVMContextImpl;
   friend class MDNode;
 
   /// The calling convention used with DW_AT_calling_convention. Actually of

include/llvm/IR/Metadata.def

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

lib/AsmParser/LLParser.cpp

else if (count.isMDField())
     Result = GET_OR_DISTINCT(
         DISubrange, (Context, count.getMDFieldValue(), lowerBound.Val));
   else
     return true;
 
   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, isUnsigned: true, name: "SomeKind")
 bool LLParser::ParseDIEnumerator(MDNode *&Result, bool IsDistinct) {
 #define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
   REQUIRED(name, MDStringField, );                                             \
   REQUIRED(value, MDSignedOrUnsignedField, );                                  \
   OPTIONAL(isUnsigned, MDBoolField, (false));
   PARSE_MD_FIELDS();
#define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
   PARSE_MD_FIELDS();
 #undef VISIT_MD_FIELDS
 
   Result = GET_OR_DISTINCT(DIBasicType, (Context, tag.Val, name.Val, size.Val,
                                          align.Val, encoding.Val, flags.Val));
   return false;
 }
 
+/// ParseDIStringType:
+///   ::= !DIStringType(name: "character(4)", size: 32, align: 32)
+bool LLParser::ParseDIStringType(MDNode *&Result, bool IsDistinct) {
+#define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
+  OPTIONAL(tag, DwarfTagField, (dwarf::DW_TAG_string_type));                   \
+  OPTIONAL(name, MDStringField, );                                             \
+  OPTIONAL(stringLength, MDField, );                                           \
+  OPTIONAL(stringLengthExpression, MDField, );                                 \
+  OPTIONAL(size, MDUnsignedField, (0, UINT64_MAX));                            \
+  OPTIONAL(align, MDUnsignedField, (0, UINT32_MAX));                           \
+  OPTIONAL(encoding, DwarfAttEncodingField, );
+  PARSE_MD_FIELDS();
+#undef VISIT_MD_FIELDS
+
+  Result = GET_OR_DISTINCT(DIStringType, (Context, tag.Val, name.Val,
+      stringLength.Val, stringLengthExpression.Val, size.Val, align.Val,
+      encoding.Val));
+  return false;
+}
+
 /// ParseDIDerivedType:
 ///   ::= !DIDerivedType(tag: DW_TAG_pointer_type, name: "int", file: !0,
 ///                      line: 7, scope: !1, baseType: !2, size: 32,
 ///                      align: 32, offset: 0, flags: 0, extraData: !3,
 ///                      dwarfAddressSpace: 3)
 bool LLParser::ParseDIDerivedType(MDNode *&Result, bool IsDistinct) {
 #define VISIT_MD_FIELDS(OPTIONAL, REQUIRED)                                    \
   REQUIRED(tag, DwarfTagField, );                                              \
Result = GET_OR_DISTINCT(
       DICompositeType,
       (Context, tag.Val, name.Val, file.Val, line.Val, scope.Val, baseType.Val,
        size.Val, align.Val, offset.Val, flags.Val, elements.Val,
        runtimeLang.Val, vtableHolder.Val, templateParams.Val, identifier.Val,
        discriminator.Val));
   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, );                                              \
   OPTIONAL(cc, DwarfCCField, );                                                \
   REQUIRED(types, MDField, );
   PARSE_MD_FIELDS();
 #undef VISIT_MD_FIELDS
 

lib/Bitcode/Reader/MetadataLoader.cpp

case BitstreamEntry::Record: {
       case bitc::METADATA_OLD_FN_NODE:
       case bitc::METADATA_OLD_NODE:
       case bitc::METADATA_VALUE:
       case bitc::METADATA_DISTINCT_NODE:
       case bitc::METADATA_NODE:
       case bitc::METADATA_LOCATION:
       case bitc::METADATA_GENERIC_DEBUG:
       case bitc::METADATA_SUBRANGE:
+      case bitc::METADATA_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:
       case bitc::METADATA_COMPILE_UNIT:
       case bitc::METADATA_SUBPROGRAM:
       case bitc::METADATA_LEXICAL_BLOCK:
       case bitc::METADATA_LEXICAL_BLOCK_FILE:
       case bitc::METADATA_NAMESPACE:
default:
       return error("Invalid record: Unsupported version of DISubrange");
     }
 
     MetadataList.assignValue(Val, NextMetadataNo);
     IsDistinct = Record[0] & 1;
     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");
 
     IsDistinct = Record[0] & 1;
     bool IsUnsigned = Record[0] & 2;
     MetadataList.assignValue(
         GET_OR_DISTINCT(DIEnumerator, (Context, unrotateSign(Record[1]),
case bitc::METADATA_BASIC_TYPE: {
     MetadataList.assignValue(
         GET_OR_DISTINCT(DIBasicType,
                         (Context, Record[1], getMDString(Record[2]), Record[3],
                          Record[4], Record[5], Flags)),
         NextMetadataNo);
     NextMetadataNo++;
     break;
   }
+  case bitc::METADATA_STRING_TYPE: {
+    if (Record.size() != 8)
+      return error("Invalid record");
+
+    IsDistinct = Record[0];
+    MetadataList.assignValue(
+        GET_OR_DISTINCT(DIStringType,
+                        (Context, Record[1], getMDString(Record[2]),
+                         getMDOrNull(Record[3]), getMDOrNull(Record[4]),
+                         Record[5], Record[6], Record[7])),
+        NextMetadataNo);
+    NextMetadataNo++;
+    break;
+  }
   case bitc::METADATA_DERIVED_TYPE: {
     if (Record.size() < 12 || Record.size() > 13)
       return error("Invalid record");
 
     // DWARF address space is encoded as N->getDWARFAddressSpace() + 1. 0 means
     // that there is no DWARF address space associated with DIDerivedType.
     Optional<unsigned> DWARFAddressSpace;
     if (Record.size() > 12 && Record[12])
if (!CT)
                             Identifier, Discriminator));
     if (!IsNotUsedInTypeRef && Identifier)
       MetadataList.addTypeRef(*Identifier, *cast<DICompositeType>(CT));
 
     MetadataList.assignValue(CT, NextMetadataNo);
     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");
     bool IsOldTypeRefArray = Record[0] < 2;
     unsigned CC = (Record.size() > 3) ? Record[3] : 0;
 
     IsDistinct = Record[0] & 0x1;
     DINode::DIFlags Flags = static_cast<DINode::DIFlags>(Record[1]);

lib/Bitcode/Writer/BitcodeWriter.cpp

private:
   unsigned createDILocationAbbrev();
   void writeDILocation(const DILocation *N, SmallVectorImpl<uint64_t> &Record,
                        unsigned &Abbrev);
   unsigned createGenericDINodeAbbrev();
   void writeGenericDINode(const GenericDINode *N,
                           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);
   void writeDIFile(const DIFile *N, SmallVectorImpl<uint64_t> &Record,
                    unsigned Abbrev);
   void writeDICompileUnit(const DICompileUnit *N,
                           SmallVectorImpl<uint64_t> &Record, unsigned Abbrev);
   void writeDISubprogram(const DISubprogram *N,
void ModuleBitcodeWriter::writeDISubrange(const DISubrange *N,
   Record.push_back((uint64_t)N->isDistinct() | Version);
   Record.push_back(VE.getMetadataOrNullID(N->getRawCountNode()));
   Record.push_back(rotateSign(N->getLowerBound()));
 
   Stream.EmitRecord(bitc::METADATA_SUBRANGE, Record, 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.push_back((N->isUnsigned() << 1) | N->isDistinct());
   Record.push_back(rotateSign(N->getValue()));
   Record.push_back(VE.getMetadataOrNullID(N->getRawName()));
 
   Stream.EmitRecord(bitc::METADATA_ENUMERATOR, Record, Abbrev);
void ModuleBitcodeWriter::writeDIBasicType(const DIBasicType *N,
   Record.push_back(N->getAlignInBits());
   Record.push_back(N->getEncoding());
   Record.push_back(N->getFlags());
 
   Stream.EmitRecord(bitc::METADATA_BASIC_TYPE, Record, Abbrev);
   Record.clear();
 }
 
+void ModuleBitcodeWriter::writeDIStringType(const DIStringType *N,
+                                           SmallVectorImpl<uint64_t> &Record,
+                                           unsigned Abbrev) {
+  Record.push_back(N->isDistinct());
+  Record.push_back(N->getTag());
+  Record.push_back(VE.getMetadataOrNullID(N->getRawName()));
+  Record.push_back(VE.getMetadataOrNullID(N->getStringLength()));
+  Record.push_back(VE.getMetadataOrNullID(N->getStringLengthExp()));
+  Record.push_back(N->getSizeInBits());
+  Record.push_back(N->getAlignInBits());
+  Record.push_back(N->getEncoding());
+
+  Stream.EmitRecord(bitc::METADATA_STRING_TYPE, Record, Abbrev);
+  Record.clear();
+}
+
 void ModuleBitcodeWriter::writeDIDerivedType(const DIDerivedType *N,
                                              SmallVectorImpl<uint64_t> &Record,
                                              unsigned Abbrev) {
   Record.push_back(N->isDistinct());
   Record.push_back(N->getTag());
   Record.push_back(VE.getMetadataOrNullID(N->getRawName()));
   Record.push_back(VE.getMetadataOrNullID(N->getFile()));
   Record.push_back(N->getLine());
void ModuleBitcodeWriter::writeDICompositeType(
   Record.push_back(VE.getMetadataOrNullID(N->getTemplateParams().get()));
   Record.push_back(VE.getMetadataOrNullID(N->getRawIdentifier()));
   Record.push_back(VE.getMetadataOrNullID(N->getDiscriminator()));
 
   Stream.EmitRecord(bitc::METADATA_COMPOSITE_TYPE, Record, 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) {
   const unsigned HasNoOldTypeRefs = 0x2;
   Record.push_back(HasNoOldTypeRefs | (unsigned)N->isDistinct());
   Record.push_back(N->getFlags());
   Record.push_back(VE.getMetadataOrNullID(N->getTypeArray().get()));
   Record.push_back(N->getCC());

lib/CodeGen/AsmPrinter/DebugLocEntry.h

Values.erase(
               return A.getExpression() == B.getExpression();
             }),
         Values.end());
   }
 
   /// 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);
 };
 
 /// Compare two Values for equality.
 inline bool operator==(const DebugLocEntry::Value &A,
                        const DebugLocEntry::Value &B) {
   if (A.EntryKind != B.EntryKind)
     return false;
 

lib/CodeGen/AsmPrinter/DebugLocStream.h

 
 /// Builder for DebugLocStream lists.
 class DebugLocStream::ListBuilder {
   DebugLocStream &Locs;
   AsmPrinter &Asm;
   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; }
 };
 
 /// Builder for DebugLocStream entries.
 class DebugLocStream::EntryBuilder {
   DebugLocStream &Locs;
 

lib/CodeGen/AsmPrinter/DebugLocStream.cpp

void DebugLocStream::finalizeEntry() {
   Comments.erase(Comments.begin() + Entries.back().CommentOffset,
                  Comments.end());
   Entries.pop_back();
 
   assert(Lists.back().EntryOffset <= Entries.size() &&
          "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);
   V.setDebugLocListIndex(ListIndex);
 }

lib/CodeGen/AsmPrinter/DwarfCompileUnit.h

public:
   SmallVector<RangeSpan, 2> takeRanges() { return std::move(CURanges); }
 
   void setBaseAddress(const MCSymbol *Base) { BaseAddress = Base; }
   const MCSymbol *getBaseAddress() const { return BaseAddress; }
 
   uint64_t getDWOId() const { return DWOId; }
   void setDWOId(uint64_t DwoId) { DWOId = DwoId; }
 
+  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;
 };
 
 } // end namespace llvm
 
 #endif // LLVM_LIB_CODEGEN_ASMPRINTER_DWARFCOMPILEUNIT_H

lib/CodeGen/AsmPrinter/DwarfCompileUnit.cpp

DIE *DwarfCompileUnit::constructVariableDIEImpl(const DbgVariable &DV,
   insertDIE(DV.getVariable(), VariableDie);
 
   if (Abstract) {
     applyVariableAttributes(DV, *VariableDie);
     return VariableDie;
   }
 
   // Add variable address.
+  constructDieLocation(*VariableDie, dwarf::DW_AT_location, DV);
+  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(*VariableDie, dwarf::DW_AT_location, Offset);
-    return VariableDie;
+      addLocationList(Die, Attribute, Offset);
+      return;
+    }
   }
 
   // Check if variable is described by a DBG_VALUE instruction.
   if (const MachineInstr *DVInsn = DV.getMInsn()) {
     assert(DVInsn->getNumOperands() == 4);
     if (DVInsn->getOperand(0).isReg()) {
       auto RegOp = DVInsn->getOperand(0);
       auto Op1 = DVInsn->getOperand(1);
       // 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.
       auto *Expr = DV.getSingleExpression();
       if (Expr && Expr->getNumElements()) {
         DIELoc *Loc = new (DIEValueAllocator) DIELoc;
         DIEDwarfExpression DwarfExpr(*Asm, *this, *Loc);
         // If there is an expression, emit raw unsigned bytes.
         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);
   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());
     DIExpressionCursor Cursor(Ops);
     DwarfExpr.setMemoryLocationKind();
     if (const MCSymbol *FrameSymbol = Asm->getFunctionFrameSymbol())
       addOpAddress(*Loc, FrameSymbol);
     else
       DwarfExpr.addMachineRegExpression(
           *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,
                                             const LexicalScope &Scope,
                                             DIE *&ObjectPointer) {
   auto Var = constructVariableDIE(DV, Scope.isAbstractScope());
   if (DV.isObjectPointer())
     ObjectPointer = Var;

lib/CodeGen/AsmPrinter/DwarfDebug.h

 /// The kind of accelerator tables we should emit.
 enum class AccelTableKind {
   Default, ///< Platform default.
   None,    ///< None.
   Apple,   ///< .apple_names, .apple_namespaces, .apple_types, .apple_objc.
   Dwarf,   ///< DWARF v5 .debug_names.
 };
 
+class DummyDwarfExpression;
+
 /// Collects and handles dwarf debug information.
 class DwarfDebug : public DebugHandlerBase {
   /// All DIEValues are allocated through this allocator.
   BumpPtrAllocator DIEValueAllocator;
 
   /// Maps MDNode with its corresponding DwarfCompileUnit.
   MapVector<const MDNode *, DwarfCompileUnit *> CUMap;
 
class DwarfDebug : public DebugHandlerBase {
   // 0, referencing the comp_dir of all the type units that use it.
   MCDwarfDwoLineTable SplitTypeUnitFileTable;
   /// @}
 
   /// True iff there are multiple CUs in this module.
   bool SingleCU;
   bool IsDarwin;
 
+  /// Map for tracking Fortran deferred CHARACTER lengths
+  DenseMap<const DIStringType*, unsigned> StringTypeLocMap;
+
+  /// Map for tracking Fortran assumed shape array descriptors
+  DenseMap<const DIFortranSubrange*, DIE*> SubrangeDieMap;
+
+  DenseMap<const DIVariable*,const DIType*> VariableInDependentType;
+
   AddressPool AddrPool;
 
   /// Accelerator tables.
   AccelTable<DWARF5AccelTableData> AccelDebugNames;
   AccelTable<AppleAccelTableOffsetData> AccelNames;
   AccelTable<AppleAccelTableOffsetData> AccelObjC;
   AccelTable<AppleAccelTableOffsetData> AccelNamespace;
   AccelTable<AppleAccelTableTypeData> AccelTypes;
class DwarfDebug : public DebugHandlerBase {
 
   /// Collect variable information from the side table maintained by MF.
   void collectVariableInfoFromMFTable(DwarfCompileUnit &TheCU,
                                       DenseSet<InlinedEntity> &P);
 
   /// Emit the reference to the section.
   void emitSectionReference(const DwarfCompileUnit &CU);
 
+  /// 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;
 
   /// Gather and emit post-function debug information.
   void endFunctionImpl(const MachineFunction *MF) override;
 
   void skippedNonDebugFunction() override;
public:
   bool isLexicalScopeDIENull(LexicalScope *Scope);
 
   /// Find the matching DwarfCompileUnit for the given CU DIE.
   DwarfCompileUnit *lookupCU(const DIE *Die) { return CUDieMap.lookup(Die); }
   const DwarfCompileUnit *lookupCU(const DIE *Die) const {
     return CUDieMap.lookup(Die);
   }
 
+  unsigned getStringTypeLoc(const DIStringType *ST) const {
+    auto I = StringTypeLocMap.find(ST);
+    return I != StringTypeLocMap.end() ? I->second : 0;
+  }
+
+  void addStringTypeLoc(const DIStringType *ST, unsigned Loc) {
+    assert(ST);
+    if (Loc)
+      StringTypeLocMap[ST] = Loc;
+  }
+
+  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.
   /// @{
   bool tuneForGDB() const { return DebuggerTuning == DebuggerKind::GDB; }
   bool tuneForLLDB() const { return DebuggerTuning == DebuggerKind::LLDB; }
   bool tuneForSCE() const { return DebuggerTuning == DebuggerKind::SCE; }
   /// @}
 
   void addSectionLabel(const MCSymbol *Sym);
   const MCSymbol *getSectionLabel(const MCSection *S);
 };
 
 } // end namespace llvm
 
 #endif // LLVM_LIB_CODEGEN_ASMPRINTER_DWARFDEBUG_H

lib/CodeGen/AsmPrinter/DwarfDebug.cpp

void DwarfDebug::ensureAbstractEntityIsCreatedIfScoped(DwarfCompileUnit &CU,
   if (CU.getExistingAbstractEntity(Node))
     return;
 
   if (LexicalScope *Scope =
           LScopes.findAbstractScope(cast_or_null<DILocalScope>(ScopeNode)))
     CU.createAbstractEntity(Node, 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<InlinedEntity> &Processed) {
   SmallDenseMap<InlinedEntity, DbgVariable *> MFVars;
   for (const auto &VI : Asm->MF->getVariableDbgInfo()) {
     if (!VI.Var)
       continue;
     assert(VI.Var->isValidLocationForIntrinsic(VI.Loc) &&
            "Expected inlined-at fields to agree");
 
     InlinedEntity Var(VI.Var, VI.Loc->getInlinedAt());
     Processed.insert(Var);
     LexicalScope *Scope = LScopes.findLexicalScope(VI.Loc);
 
     // If variable scope is not found then skip this variable.
     if (!Scope)
       continue;
 
     ensureAbstractEntityIsCreatedIfScoped(TheCU, Var.first, Scope->getScopeNode());
     auto RegVar = llvm::make_unique<DbgVariable>(
                     cast<DILocalVariable>(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())) {
       MFVars.insert({Var, RegVar.get()});
       ConcreteEntities.push_back(std::move(RegVar));
     }
   }
 }
static bool validThroughout(LexicalScopes &LScopes,
   // necessarily correct. It would be much better to use a dbg.declare instead
   // if we know the constant is live throughout the scope.
   if (DbgValue->getOperand(0).isImm() && MBB->pred_empty())
     return true;
 
   return false;
 }
 
+void DwarfDebug::populateDependentTypeMap() {
+  for (const auto &I : DbgValues) {
+    InlinedEntity IV = I.first;
+    if (I.second.empty())
+      continue;
+
+    if (const DIVariable *V = dyn_cast<DIVariable>(IV.first)) {
+      if (const DIStringType *ST = dyn_cast<DIStringType>(
+              static_cast<const Metadata *>(V->getType())))
+        if (const DIVariable *LV = ST->getStringLength())
+          VariableInDependentType[LV] = ST;
+
+      if (const DIFortranArrayType *AT = dyn_cast<DIFortranArrayType>(
+              static_cast<const Metadata *>(V->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::collectEntityInfo(DwarfCompileUnit &TheCU,
                                    const DISubprogram *SP,
                                    DenseSet<InlinedEntity> &Processed) {
+  clearDependentTracking();
+  populateDependentTypeMap();
   // Grab the variable info that was squirreled away in the MMI side-table.
   collectVariableInfoFromMFTable(TheCU, Processed);
 
   for (const auto &I : DbgValues) {
     InlinedEntity IV = I.first;
     if (Processed.count(IV))
       continue;
 
for (const auto &I : DbgValues) {
     // unique identifiers, so don't bother resolving the type with the
     // identifier map.
     const DIBasicType *BT = dyn_cast<DIBasicType>(
         static_cast<const Metadata *>(LocalVar->getType()));
 
     // Finalize the entry by lowering it into a DWARF bytestream.
     for (auto &Entry : Entries)
       Entry.finalize(*Asm, List, BT);
+    List.finalize();
+
+    if (const DIVariable *V = dyn_cast<DIVariable>(IV.first))
+      if (VariableInDependentType.count(V)) {
+        const DIType *DT = VariableInDependentType[V];
+        if (const DIStringType *ST = dyn_cast<DIStringType>(DT)) {
+          unsigned Offset;
+          if (const DILocalVariable *LV = dyn_cast<DILocalVariable>(V)) {
+            DbgVariable TVar = {LV, 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);
+          }
+        }
+      }
   }
 
   // For each InlinedEntity collected from DBG_LABEL instructions, convert to
   // DWARF-related DbgLabel.
   for (const auto &I : DbgLabels) {
     InlinedEntity IL = I.first;
     const MachineInstr *MI = I.second;
     if (MI == nullptr)
void DebugLocEntry::finalize(const AsmPrinter &AP,
 
   } else {
     assert(Values.size() == 1 && "only fragments may have >1 value");
     emitDebugLocValue(AP, BT, Value, DwarfExpr);
   }
   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, Value, DwarfExpr);
+  DwarfExpr.finalize();
+}
+
 void DwarfDebug::emitDebugLocEntryLocation(const DebugLocStream::Entry &Entry) {
   // Emit the size.
   Asm->OutStreamer->AddComment("Loc expr size");
   Asm->emitInt16(DebugLocs.getBytes(Entry).size());
 
   // Emit the entry.
   APByteStreamer Streamer(*Asm);
   emitDebugLocEntry(Streamer, Entry);

lib/CodeGen/AsmPrinter/DwarfExpression.h

 
 public:
   DebugLocDwarfExpression(unsigned DwarfVersion, ByteStreamer &BS)
       : DwarfExpression(DwarfVersion), BS(BS) {}
 };
 
 /// DwarfExpression implementation for singular DW_AT_location.
 class DIEDwarfExpression final : public DwarfExpression {
   const AsmPrinter ≈
   DwarfUnit &DU;
   DIELoc ¨
 
   void emitOp(uint8_t Op, const char *Comment = nullptr) override;
   void emitSigned(int64_t Value) override;
   void emitUnsigned(uint64_t Value) override;
   bool isFrameRegister(const TargetRegisterInfo &TRI,
                        unsigned MachineReg) override;

lib/CodeGen/AsmPrinter/DwarfExpression.cpp

case dwarf::DW_OP_LLVM_fragment: {
       LocationKind = Unknown;
       return;
     }
     case dwarf::DW_OP_plus_uconst:
       assert(LocationKind != Register);
       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:
     case dwarf::DW_OP_div:
     case dwarf::DW_OP_mod:
     case dwarf::DW_OP_or:
     case dwarf::DW_OP_and:
     case dwarf::DW_OP_xor:

lib/CodeGen/AsmPrinter/DwarfUnit.h

protected:
   void updateAcceleratorTables(const DIScope *Context, const DIType *Ty,
                                const DIE &TyDIE);
 
   /// Emit the common part of the header for this unit.
   void emitCommonHeader(bool UseOffsets, dwarf::UnitType UT);
 
 private:
   void constructTypeDIE(DIE &Buffer, const DIBasicType *BTy);
+  void constructTypeDIE(DIE &Buffer, const DIStringType *BTy);
+  void constructTypeDIE(DIE &Buffer, const DIFortranArrayType *ATy);
   void constructTypeDIE(DIE &Buffer, const DIDerivedType *DTy);
   void constructTypeDIE(DIE &Buffer, const DISubroutineType *CTy);
   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);
   DIE &constructMemberDIE(DIE &Buffer, const DIDerivedType *DT);
   void constructTemplateTypeParameterDIE(DIE &Buffer,
                                          const DITemplateTypeParameter *TP);
   void constructTemplateValueParameterDIE(DIE &Buffer,
                                           const DITemplateValueParameter *TVP);
 
   /// Return the default lower bound for an array.

lib/CodeGen/AsmPrinter/DwarfUnit.cpp

DIE *DwarfUnit::getOrCreateTypeDIE(const MDNode *TyNode) {
 
   // Create new type.
   DIE &TyDIE = createAndAddDIE(Ty->getTag(), *ContextDIE, Ty);
 
   updateAcceleratorTables(Context, Ty, TyDIE);
 
   if (auto *BT = dyn_cast<DIBasicType>(Ty))
     constructTypeDIE(TyDIE, BT);
+  else if (auto *ST = dyn_cast<DIStringType>(Ty))
+    constructTypeDIE(TyDIE, ST);
   else if (auto *STy = dyn_cast<DISubroutineType>(Ty))
     constructTypeDIE(TyDIE, STy);
+  else if (auto *ATy = dyn_cast<DIFortranArrayType>(Ty))
+    constructArrayTypeDIE(TyDIE, ATy);
   else if (auto *CTy = dyn_cast<DICompositeType>(Ty)) {
     if (DD->generateTypeUnits() && !Ty->isForwardDecl())
       if (MDString *TypeId = CTy->getRawIdentifier()) {
         DD->addDwarfTypeUnitType(getCU(), TypeId->getString(), TyDIE, CTy);
         // Skip updating the accelerator tables since this is not the full type.
         return &TyDIE;
       }
     constructTypeDIE(TyDIE, CTy);
void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIBasicType *BTy) {
   // Add name if not anonymous or intermediate type.
   if (!Name.empty())
     addString(Buffer, dwarf::DW_AT_name, Name);
 
   // An unspecified type only has a name attribute.
   if (BTy->getTag() == dwarf::DW_TAG_unspecified_type)
     return;
 
+  if (BTy->getTag() != dwarf::DW_TAG_string_type)
     addUInt(Buffer, dwarf::DW_AT_encoding, dwarf::DW_FORM_data1,
             BTy->getEncoding());
 
   uint64_t Size = BTy->getSizeInBits() >> 3;
   addUInt(Buffer, dwarf::DW_AT_byte_size, None, Size);
 
   if (BTy->isBigEndian())
     addUInt(Buffer, dwarf::DW_AT_endianity, None, dwarf::DW_END_big);
   else if (BTy->isLittleEndian())
     addUInt(Buffer, dwarf::DW_AT_endianity, None, dwarf::DW_END_little);
 }
 
+void DwarfUnit::constructTypeDIE(DIE &Buffer, const DIStringType *STy) {
+  // Get core information.
+  StringRef Name = STy->getName();
+  // Add name if not anonymous or intermediate type.
+  if (!Name.empty())
+    addString(Buffer, dwarf::DW_AT_name, Name);
+
+  if (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();
   uint64_t Size = DTy->getSizeInBits() >> 3;
   uint16_t Tag = Buffer.getTag();
 
   // Map to main type, void will not have a type.
   const DIType *FromTy = resolve(DTy->getBaseType());
void DwarfUnit::constructSubrangeDIE(DIE &Buffer, const DISubrange *SR,
 
   if (auto *CV = SR->getCount().dyn_cast<DIVariable*>()) {
     if (auto *CountVarDIE = getDIE(CV))
       addDIEEntry(DW_Subrange, dwarf::DW_AT_count, *CountVarDIE);
   } else if (Count != -1)
     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, dwarf::DW_FORM_sdata, BVC);
+  }
+
+  if ((!SR->getUpperBound()) && (!SR->noUpperBound())) {
+    int64_t BVC = SR->getCUpperBound();
+    addSInt(DW_Subrange, dwarf::DW_AT_upper_bound, dwarf::DW_FORM_sdata, BVC);
+  }
+}
+
 DIE *DwarfUnit::getIndexTyDie() {
   if (IndexTyDie)
     return IndexTyDie;
   // Construct an integer type to use for indexes.
   IndexTyDie = &createAndAddDIE(dwarf::DW_TAG_base_type, getUnitDie());
   StringRef Name = "__ARRAY_SIZE_TYPE__";
   addString(*IndexTyDie, dwarf::DW_AT_name, Name);
   addUInt(*IndexTyDie, dwarf::DW_AT_byte_size, None, sizeof(int64_t));
void DwarfUnit::constructArrayTypeDIE(DIE &Buffer, const DICompositeType *CTy) {
   for (unsigned i = 0, N = Elements.size(); i < N; ++i) {
     // FIXME: Should this really be such a loose cast?
     if (auto *Element = dyn_cast_or_null<DINode>(Elements[i]))
       if (Element->getTag() == dwarf::DW_TAG_subrange_type)
         constructSubrangeDIE(Buffer, cast<DISubrange>(Element), IdxTy);
   }
 }
 
+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) {
   const DIType *DTy = resolve(CTy->getBaseType());
   bool IsUnsigned = DTy && isUnsignedDIType(DD, DTy);
   if (DTy) {
     if (DD->getDwarfVersion() >= 3)
       addType(Buffer, DTy);
     if (DD->getDwarfVersion() >= 4 && (CTy->getFlags() & DINode::FlagFixedEnum))
       addFlag(Buffer, dwarf::DW_AT_enum_class);

lib/IR/AsmWriter.cpp

if (auto *CE = N->getCount().dyn_cast<ConstantInt*>())
     Printer.printInt("count", CE->getSExtValue(), /* ShouldSkipZero */ false);
   else
     Printer.printMetadata("count", N->getCount().dyn_cast<DIVariable*>(),
                           /*ShouldSkipNull */ false);
   Printer.printInt("lowerBound", N->getLowerBound());
   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(";
   MDFieldPrinter Printer(Out);
   Printer.printString("name", N->getName(), /* ShouldSkipEmpty */ false);
   if (N->isUnsigned()) {
     auto Value = static_cast<uint64_t>(N->getValue());
     Printer.printInt("value", Value, /* ShouldSkipZero */ false);
static void writeDIBasicType(raw_ostream &Out, const DIBasicType *N,
   Printer.printInt("size", N->getSizeInBits());
   Printer.printInt("align", N->getAlignInBits());
   Printer.printDwarfEnum("encoding", N->getEncoding(),
                          dwarf::AttributeEncodingString);
   Printer.printDIFlags("flags", N->getFlags());
   Out << ")";
 }
 
+static void writeDIStringType(raw_ostream &Out, const DIStringType *N,
+                             TypePrinting *TypePrinter, SlotTracker *Machine,
+                              const Module *Context) {
+  Out << "!DIStringType(";
+  MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
+  if (N->getTag() != dwarf::DW_TAG_string_type)
+    Printer.printTag(N);
+  Printer.printString("name", N->getName());
+  Printer.printMetadata("stringLength", N->getRawStringLength());
+  Printer.printMetadata("stringLengthExpression", N->getRawStringLengthExp());
+  Printer.printInt("size", N->getSizeInBits());
+  Printer.printInt("align", N->getAlignInBits());
+  Printer.printDwarfEnum("encoding", N->getEncoding(),
+                         dwarf::AttributeEncodingString);
+  Out << ")";
+}
+
 static void writeDIDerivedType(raw_ostream &Out, const DIDerivedType *N,
                                TypePrinting *TypePrinter, SlotTracker *Machine,
                                const Module *Context) {
   Out << "!DIDerivedType(";
   MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
   Printer.printTag(N);
   Printer.printString("name", N->getName());
   Printer.printMetadata("scope", N->getRawScope());
Printer.printDwarfEnum("runtimeLang", N->getRuntimeLang(),
                          dwarf::LanguageString);
   Printer.printMetadata("vtableHolder", N->getRawVTableHolder());
   Printer.printMetadata("templateParams", N->getRawTemplateParams());
   Printer.printString("identifier", N->getIdentifier());
   Printer.printMetadata("discriminator", N->getRawDiscriminator());
   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) {
   Out << "!DISubroutineType(";
   MDFieldPrinter Printer(Out, TypePrinter, Machine, Context);
   Printer.printDIFlags("flags", N->getFlags());
   Printer.printDwarfEnum("cc", N->getCC(), dwarf::ConventionString);
   Printer.printMetadata("types", N->getRawTypeArray(),

lib/IR/DIBuilder.cpp

 DIBasicType *DIBuilder::createBasicType(StringRef Name, uint64_t SizeInBits,
                                         unsigned Encoding,
                                         DINode::DIFlags Flags) {
   assert(!Name.empty() && "Unable to create type without name");
   return DIBasicType::get(VMContext, dwarf::DW_TAG_base_type, Name, SizeInBits,
                           0, Encoding, Flags);
 }
 
+DIStringType *DIBuilder::createStringType(StringRef Name, uint64_t SizeInBits) {
+  assert(!Name.empty() && "Unable to create type without name");
+  return DIStringType::get(VMContext, dwarf::DW_TAG_string_type, Name,
+                           SizeInBits, 0);
+}
+
 DIDerivedType *DIBuilder::createQualifiedType(unsigned Tag, DIType *FromTy) {
   return DIDerivedType::get(VMContext, Tag, "", nullptr, 0, nullptr, FromTy, 0,
                             0, 0, None, DINode::FlagZero);
 }
 
 DIDerivedType *DIBuilder::createPointerType(
     DIType *PointeeTy,
     uint64_t SizeInBits,
DICompositeType *DIBuilder::createArrayType(uint64_t Size,
                                             DINodeArray Subscripts) {
   auto *R = DICompositeType::get(VMContext, dwarf::DW_TAG_array_type, "",
                                  nullptr, 0, nullptr, Ty, Size, AlignInBits, 0,
                                  DINode::FlagZero, Subscripts, 0, nullptr);
   trackIfUnresolved(R);
   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) {
   auto *R = DICompositeType::get(VMContext, dwarf::DW_TAG_array_type, "",
                                  nullptr, 0, nullptr, Ty, Size, AlignInBits, 0,
                                  DINode::FlagVector, Subscripts, 0, nullptr);
   trackIfUnresolved(R);
   return R;

 DISubrange *DIBuilder::getOrCreateSubrange(int64_t Lo, int64_t Count) {
   return DISubrange::get(VMContext, Count, Lo);
 }
 
 DISubrange *DIBuilder::getOrCreateSubrange(int64_t Lo, Metadata *CountNode) {
   return DISubrange::get(VMContext, CountNode, 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 =
           dyn_cast_or_null<DICompositeType>(getNonCompileUnitScope(Context)))
     assert(CT->getIdentifier().empty() &&
            "Context of a global variable should not be a type with identifier");
 #endif
 }

lib/IR/DebugInfoMetadata.cpp

 DISubrange *DISubrange::getImpl(LLVMContext &Context, Metadata *CountNode,
                                 int64_t Lo, StorageType Storage,
                                 bool ShouldCreate) {
   DEFINE_GETIMPL_LOOKUP(DISubrange, (CountNode, Lo));
   Metadata *Ops[] = { CountNode };
   DEFINE_GETIMPL_STORE(DISubrange, (CountNode, Lo), Ops);
 }
 
+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,
                                     bool IsUnsigned, MDString *Name,
                                     StorageType Storage, bool ShouldCreate) {
   assert(isCanonical(Name) && "Expected canonical MDString");
   DEFINE_GETIMPL_LOOKUP(DIEnumerator, (Value, IsUnsigned, Name));
   Metadata *Ops[] = {Name};
   DEFINE_GETIMPL_STORE(DIEnumerator, (Value, IsUnsigned), Ops);
 }
Optional<DIBasicType::Signedness> DIBasicType::getSignedness() const {
   case dwarf::DW_ATE_unsigned:
   case dwarf::DW_ATE_unsigned_char:
     return Signedness::Unsigned;
   default:
     return None;
   }
 }
 
+DIStringType *DIStringType::getImpl(LLVMContext &Context, unsigned Tag,
+                                    MDString *Name, Metadata *StringLength,
+                                    Metadata *StringLengthExp,
+                                    uint64_t SizeInBits, uint32_t AlignInBits,
+                                    unsigned Encoding, StorageType Storage,
+                                    bool ShouldCreate) {
+  assert(isCanonical(Name) && "Expected canonical MDString");
+  DEFINE_GETIMPL_LOOKUP(DIStringType,
+                        (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                         AlignInBits, Encoding));
+  Metadata *Ops[] = {nullptr, nullptr, Name, StringLength, StringLengthExp};
+  DEFINE_GETIMPL_STORE(DIStringType, (Tag, SizeInBits, AlignInBits, Encoding),
+                       Ops);
+}
+
 DIDerivedType *DIDerivedType::getImpl(
     LLVMContext &Context, unsigned Tag, MDString *Name, Metadata *File,
     unsigned Line, Metadata *Scope, Metadata *BaseType, uint64_t SizeInBits,
     uint32_t AlignInBits, uint64_t OffsetInBits,
     Optional<unsigned> DWARFAddressSpace, DIFlags Flags, Metadata *ExtraData,
     StorageType Storage, bool ShouldCreate) {
   assert(isCanonical(Name) && "Expected canonical MDString");
   DEFINE_GETIMPL_LOOKUP(DIDerivedType,
DICompositeType *DICompositeType::getImpl(
   Metadata *Ops[] = {File,     Scope,        Name,           BaseType,
                      Elements, VTableHolder, TemplateParams, Identifier,
                      Discriminator};
   DEFINE_GETIMPL_STORE(DICompositeType, (Tag, Line, RuntimeLang, SizeInBits,
                                          AlignInBits, OffsetInBits, Flags),
                        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,
     uint64_t SizeInBits, uint32_t AlignInBits, uint64_t OffsetInBits,
     DIFlags Flags, Metadata *Elements, unsigned RuntimeLang,
     Metadata *VTableHolder, Metadata *TemplateParams, Metadata *Discriminator) {
   assert(!Identifier.getString().empty() && "Expected valid identifier");
   if (!Context.isODRUniquingDebugTypes())

 }
 
 unsigned DIExpression::ExprOperand::getSize() const {
   switch (getOp()) {
   case dwarf::DW_OP_LLVM_fragment:
     return 3;
   case dwarf::DW_OP_constu:
   case dwarf::DW_OP_plus_uconst:
+  case dwarf::DW_OP_deref_size:
     return 2;
   default:
     return 1;
   }
 }
 
 bool DIExpression::isValid() const {
   for (auto I = expr_op_begin(), E = expr_op_end(); I != E; ++I) {
for (auto I = expr_op_begin(), E = expr_op_end(); I != E; ++I) {
     case dwarf::DW_OP_or:
     case dwarf::DW_OP_and:
     case dwarf::DW_OP_xor:
     case dwarf::DW_OP_shl:
     case dwarf::DW_OP_shr:
     case dwarf::DW_OP_shra:
     case dwarf::DW_OP_deref:
     case dwarf::DW_OP_xderef:
+    case dwarf::DW_OP_deref_size:
     case dwarf::DW_OP_lit0:
     case dwarf::DW_OP_not:
     case dwarf::DW_OP_dup:
       break;
     }
   }
   return true;
 }

lib/IR/LLVMContextImpl.h

template <> struct MDNodeKeyImpl<DISubrange> {
   unsigned getHashValue() const {
     if (auto *MD = dyn_cast<ConstantAsMetadata>(CountNode))
       return hash_combine(cast<ConstantInt>(MD->getValue())->getSExtValue(),
                           LowerBound);
     return hash_combine(CountNode, 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;
   bool IsUnsigned;
 
   MDNodeKeyImpl(int64_t Value, bool IsUnsigned, MDString *Name)
       : Value(Value), Name(Name), IsUnsigned(IsUnsigned) {}
   MDNodeKeyImpl(const DIEnumerator *N)
return Tag == RHS->getTag() && Name == RHS->getRawName() &&
            Flags == RHS->getFlags();
   }
 
   unsigned getHashValue() const {
     return hash_combine(Tag, Name, SizeInBits, AlignInBits, Encoding);
   }
 };
 
+template <> struct MDNodeKeyImpl<DIStringType> {
+  unsigned Tag;
+  MDString *Name;
+  Metadata *StringLength;
+  Metadata *StringLengthExp;
+  uint64_t SizeInBits;
+  uint32_t AlignInBits;
+  unsigned Encoding;
+
+  MDNodeKeyImpl(unsigned Tag, MDString *Name, Metadata *StringLength,
+                Metadata *StringLengthExp, uint64_t SizeInBits,
+                uint32_t AlignInBits, unsigned Encoding)
+      : Tag(Tag), Name(Name), StringLength(StringLength),
+        StringLengthExp(StringLengthExp), SizeInBits(SizeInBits),
+        AlignInBits(AlignInBits), Encoding(Encoding) {}
+  MDNodeKeyImpl(const DIStringType *N)
+      : Tag(N->getTag()), Name(N->getRawName()),
+        StringLength(N->getRawStringLength()),
+        StringLengthExp(N->getRawStringLengthExp()),
+        SizeInBits(N->getSizeInBits()),
+        AlignInBits(N->getAlignInBits()), Encoding(N->getEncoding()) {}
+
+  bool isKeyOf(const DIStringType *RHS) const {
+    return Tag == RHS->getTag() && Name == RHS->getRawName() &&
+           SizeInBits == RHS->getSizeInBits() &&
+           AlignInBits == RHS->getAlignInBits() &&
+           Encoding == RHS->getEncoding();
+  }
+  unsigned getHashValue() const {
+    return hash_combine(Tag, Name, SizeInBits, AlignInBits, Encoding);
+  }
+};
+
 template <> struct MDNodeKeyImpl<DIDerivedType> {
   unsigned Tag;
   MDString *Name;
   Metadata *File;
   unsigned Line;
   Metadata *Scope;
   Metadata *BaseType;
   uint64_t SizeInBits;
unsigned getHashValue() const {
     // 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,
                         TemplateParams);
   }
 };
 
+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;
   Metadata *TypeArray;
 
   MDNodeKeyImpl(unsigned Flags, uint8_t CC, Metadata *TypeArray)
       : Flags(Flags), CC(CC), TypeArray(TypeArray) {}
   MDNodeKeyImpl(const DISubroutineType *N)

lib/IR/Verifier.cpp

void Verifier::visitDISubrange(const DISubrange &N) {
   auto Count = N.getCount();
   AssertDI(Count, "Count must either be a signed constant or a DIVariable",
            &N);
   AssertDI(!Count.is<ConstantInt*>() ||
                Count.get<ConstantInt*>()->getSExtValue() >= -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);
 }
 
 void Verifier::visitDIBasicType(const DIBasicType &N) {
   AssertDI(N.getTag() == dwarf::DW_TAG_base_type ||
-               N.getTag() == dwarf::DW_TAG_unspecified_type,
+               N.getTag() == dwarf::DW_TAG_unspecified_type ||
+               N.getTag() == dwarf::DW_TAG_string_type,
+           "invalid tag", &N);
+}
+
+void Verifier::visitDIStringType(const DIStringType &N) {
+  AssertDI( N.getTag() == dwarf::DW_TAG_string_type,
            "invalid tag", &N);
   AssertDI(!(N.isBigEndian() && N.isLittleEndian()) ,
             "has conflicting flags", &N);
 }
 
 void Verifier::visitDIDerivedType(const DIDerivedType &N) {
   // Common scope checks.
   visitDIScope(N);
void Verifier::visitDICompositeType(const DICompositeType &N) {
   }
 
   if (auto *D = N.getRawDiscriminator()) {
     AssertDI(isa<DIDerivedType>(D) && N.getTag() == dwarf::DW_TAG_variant_part,
              "discriminator can only appear on variant part");
   }
 }
 
+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()) {
     AssertDI(isa<MDTuple>(Types), "invalid composite elements", &N, Types);
     for (Metadata *Ty : N.getTypeArray()->operands()) {
       AssertDI(isType(Ty), "invalid subroutine type ref", &N, Types, Ty);
     }
   }

test/DebugInfo/fortran-array-type.ll

+; Test for !DIFortranArrayType and !DIFortranSubrange. These two DI are
+; used to construct a Fortran array with constant or dynamic lower and/or
+; upper bounds in the declaration of its rank(s).
+
+; RUN: llvm-as < %s | llvm-dis | llvm-as | llvm-dis | FileCheck %s
+; CHECK: !DIFortranArrayType(tag: DW_TAG_array_type,
+; CHECK: !DIFortranSubrange({{.*}}lowerBound: !{{[0-9]+}}, lowerBoundExpression: !DIExpression(DW_OP_deref), upperBound: !{{[0-9]+}}, upperBoundExpression: !DIExpression(DW_OP_deref))
+; CHECK: !DIFortranSubrange(constLowerBound: 1,{{.*}} upperBound: !{{[0-9]+}}, upperBoundExpression: !DIExpression(DW_OP_deref)
+; CHECK: !DIFortranSubrange({{.*}}constUpperBound: 10, lowerBound: !{{[0-9]+}}, lowerBoundExpression: !DIExpression(DW_OP_deref)
+; CHECK: !DIFortranSubrange(constLowerBound: -5, constUpperBound: 5)
+
+!llvm.module.flags = !{!0, !1}
+!llvm.dbg.cu = !{!2}
+
+!0 = !{i32 2, !"Dwarf Version", i32 2}
+!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-array-type.f", directory: "/")
+!4 = !{}
+!5 = !{!6}
+!6 = !DIFortranArrayType(tag: DW_TAG_array_type, baseType: !7, size: 32, align: 32, elements: !8)
+!7 = !DIBasicType(name: "real", size: 32, align: 32, encoding: DW_ATE_float)
+!8 = !{!9, !17, !18, !20}
+!9 = !DIFortranSubrange(lowerBound: !10, lowerBoundExpression: !DIExpression(DW_OP_deref), upperBound: !16, upperBoundExpression: !DIExpression(DW_OP_deref))
+!10 = !DILocalVariable(name: "Px", scope: !11, file: !3, line: 256, type: !15, flags: DIFlagArtificial)
+!11 = !DILexicalBlock(scope: !12, file: !3, line: 256, column: 1)
+!12 = distinct !DISubprogram(name: "subprgm", scope: !2, file: !3, line: 256, type: !13, isLocal: false, isDefinition: true, scopeLine: 256, isOptimized: false, unit: !2)
+!13 = !DISubroutineType(types: !14)
+!14 = !{null, !7}
+!15 = !DIBasicType(name: "integer*8", size: 64, align: 64, encoding: DW_ATE_signed)
+!16 = !DILocalVariable(name: "Py", scope: !11, file: !3, line: 256, type: !15, flags: DIFlagArtificial)
+!17 = !DIFortranSubrange(constLowerBound: 1, upperBound: !16, upperBoundExpression: !DIExpression(DW_OP_deref))
+!18 = !DIFortranSubrange(lowerBound: !19, lowerBoundExpression: !DIExpression(DW_OP_deref), constUpperBound: 10)
+!19 = !DILocalVariable(name: "Pz", scope: !11, file: !3, line: 256, type: !15, flags: DIFlagArtificial)
+!20 = !DIFortranSubrange(constLowerBound: -5, constUpperBound: 5)

test/DebugInfo/fortran-string-type.ll

+; Test for !DIStringType. This DI is used to construct a Fortran CHARACTER
+; intrinsic type, either with a compile-time constant LEN type parameter or
+; when LEN is a dynamic parameter as in a deferred-length CHARACTER.  (See
+; section 7.4.4 of the Fortran 2018 standard.)
+
+; RUN: llvm-as < %s | llvm-dis | llvm-as | llvm-dis | FileCheck %s
+; CHECK: !DIStringType(name: "character(*)", stringLength: !{{[0-9]+}}, stringLengthExpression: !DIExpression(), size: 32)
+; CHECK: !DIStringType(name: "character(10)", size: 80, align: 8)
+; CHECK: !DIBasicType(tag: DW_TAG_string_type
+
+!llvm.module.flags = !{!0, !1}
+!llvm.dbg.cu = !{!2}
+
+!0 = !{i32 2, !"Dwarf Version", i32 2}
+!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")