@@ -101,73 +101,55 @@ static const typeInfo::DerivedType *GetDerivedType(const Descriptor &desc) {
101101}
102102
103103bool RTNAME (SameTypeAs)(const Descriptor &a, const Descriptor &b) {
104- // Unlimited polymorphic with intrinsic dynamic type.
105- if (a.raw ().type != CFI_type_struct && a.raw ().type != CFI_type_other &&
106- b.raw ().type != CFI_type_struct && b.raw ().type != CFI_type_other)
107- return a.raw ().type == b.raw ().type ;
108-
109- const typeInfo::DerivedType *derivedTypeA{GetDerivedType (a)};
110- const typeInfo::DerivedType *derivedTypeB{GetDerivedType (b)};
111-
112- // No dynamic type in one or both descriptor.
113- if (derivedTypeA == nullptr || derivedTypeB == nullptr ) {
114- return false ;
115- }
116-
117- // Exact match of derived type.
118- if (derivedTypeA == derivedTypeB) {
119- return true ;
104+ auto aType{a.raw ().type };
105+ auto bType{b.raw ().type };
106+ if ((aType != CFI_type_struct && aType != CFI_type_other) ||
107+ (bType != CFI_type_struct && bType != CFI_type_other)) {
108+ // If either type is intrinsic, they must match.
109+ return aType == bType;
110+ } else {
111+ const typeInfo::DerivedType *derivedTypeA{GetDerivedType (a)};
112+ const typeInfo::DerivedType *derivedTypeB{GetDerivedType (b)};
113+ if (derivedTypeA == nullptr || derivedTypeB == nullptr ) {
114+ // Unallocated/disassociated CLASS(*) never matches.
115+ return false ;
116+ } else if (derivedTypeA == derivedTypeB) {
117+ // Exact match of derived type.
118+ return true ;
119+ } else {
120+ // Otherwise compare with the name. Note 16.29 kind type parameters are
121+ // not considered in the test.
122+ return CompareDerivedTypeNames (
123+ derivedTypeA->name (), derivedTypeB->name ());
124+ }
120125 }
121- // Otherwise compare with the name. Note 16.29 kind type parameters are not
122- // considered in the test.
123- return CompareDerivedTypeNames (derivedTypeA->name (), derivedTypeB->name ());
124126}
125127
126128bool RTNAME (ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) {
127- if (a.raw ().type != CFI_type_struct && a.raw ().type != CFI_type_other &&
128- mold.raw ().type != CFI_type_struct && mold.raw ().type != CFI_type_other)
129- return a.raw ().type == mold.raw ().type ;
130-
131- const typeInfo::DerivedType *derivedTypeA{GetDerivedType (a)};
132- const typeInfo::DerivedType *derivedTypeMold{GetDerivedType (mold)};
133-
134- // If MOLD is unlimited polymorphic and is either a disassociated pointer or
135- // unallocated allocatable, the result is true.
136- // Unlimited polymorphic descriptors are initialized with a CFI_type_other
137- // type.
138- if (mold.type ().raw () == CFI_type_other &&
139- (mold.IsAllocatable () || mold.IsPointer ()) &&
140- derivedTypeMold == nullptr ) {
141- return true ;
142- }
143-
144- // If A is unlimited polymorphic and is either a disassociated pointer or
145- // unallocated allocatable, the result is false.
146- // Unlimited polymorphic descriptors are initialized with a CFI_type_other
147- // type.
148- if (a.type ().raw () == CFI_type_other &&
149- (a.IsAllocatable () || a.IsPointer ()) && derivedTypeA == nullptr ) {
150- return false ;
151- }
152-
153- if (derivedTypeA == nullptr || derivedTypeMold == nullptr ) {
129+ auto aType{a.raw ().type };
130+ auto moldType{mold.raw ().type };
131+ if ((aType != CFI_type_struct && aType != CFI_type_other) ||
132+ (moldType != CFI_type_struct && moldType != CFI_type_other)) {
133+ // If either type is intrinsic, they must match.
134+ return aType == moldType;
135+ } else if (const typeInfo::DerivedType *
136+ derivedTypeMold{GetDerivedType (mold)}) {
137+ // If A is unlimited polymorphic and is either a disassociated pointer or
138+ // unallocated allocatable, the result is false.
139+ // Otherwise if the dynamic type of A or MOLD is extensible, the result is
140+ // true if and only if the dynamic type of A is an extension type of the
141+ // dynamic type of MOLD.
142+ for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType (a)};
143+ derivedTypeA; derivedTypeA = derivedTypeA->GetParentType ()) {
144+ if (CompareDerivedType (derivedTypeA, derivedTypeMold)) {
145+ return true ;
146+ }
147+ }
154148 return false ;
155- }
156-
157- // Otherwise if the dynamic type of A or MOLD is extensible, the result is
158- // true if and only if the dynamic type of A is an extension type of the
159- // dynamic type of MOLD.
160- if (CompareDerivedType (derivedTypeA, derivedTypeMold)) {
149+ } else {
150+ // MOLD is unlimited polymorphic and unallocated/disassociated.
161151 return true ;
162152 }
163- const typeInfo::DerivedType *parent{derivedTypeA->GetParentType ()};
164- while (parent) {
165- if (CompareDerivedType (parent, derivedTypeMold)) {
166- return true ;
167- }
168- parent = parent->GetParentType ();
169- }
170- return false ;
171153}
172154
173155void RTNAME (DestroyWithoutFinalization)(const Descriptor &descriptor) {
0 commit comments