diff --git a/flang/lib/Evaluate/constant.cpp b/flang/lib/Evaluate/constant.cpp index 990339958399e..0fa397b9c356d 100644 --- a/flang/lib/Evaluate/constant.cpp +++ b/flang/lib/Evaluate/constant.cpp @@ -389,7 +389,45 @@ std::size_t Constant::CopyFrom(const Constant &source, return Base::CopyFrom(source, count, resultSubscripts, dimOrder); } +static std::optional DerivedTypeDepth(const semantics::Scope &scope) { + if (scope.IsDerivedType()) { + for (auto iter{scope.cbegin()}; iter != scope.cend(); ++iter) { + const Symbol &symbol{*iter->second}; + if (symbol.test(Symbol::Flag::ParentComp)) { + if (const semantics::DeclTypeSpec *type{symbol.GetType()}) { + if (const semantics::DerivedTypeSpec *derived{type->AsDerived()}) { + const semantics::Scope *parent{derived->scope()}; + if (!parent) { + parent = derived->typeSymbol().scope(); + } + if (parent) { + if (auto parentDepth{DerivedTypeDepth(*parent)}) { + return 1 + *parentDepth; + } + } + } + } + return std::nullopt; // error recovery + } + } + return 0; + } else { + return std::nullopt; // error recovery + } +} + bool ComponentCompare::operator()(SymbolRef x, SymbolRef y) const { + if (&x->owner() != &y->owner()) { + // Not components of the same derived type; put ancestors' components first. + if (auto xDepth{DerivedTypeDepth(x->owner())}) { + if (auto yDepth{DerivedTypeDepth(y->owner())}) { + if (*xDepth != *yDepth) { + return *xDepth < *yDepth; + } + } + } + } + // Same derived type, distinct instantiations, or error recovery. return semantics::SymbolSourcePositionCompare{}(x, y); } diff --git a/flang/test/Evaluate/Inputs/comporder1.mod b/flang/test/Evaluate/Inputs/comporder1.mod new file mode 100644 index 0000000000000..5c1a3c89d5e1e --- /dev/null +++ b/flang/test/Evaluate/Inputs/comporder1.mod @@ -0,0 +1,6 @@ +!mod$ v1 sum:64657f78d85da21d +module comporder1 +type::base +integer(4)::c1 +end type +end diff --git a/flang/test/Evaluate/Inputs/comporder2.mod b/flang/test/Evaluate/Inputs/comporder2.mod new file mode 100644 index 0000000000000..e228639669642 --- /dev/null +++ b/flang/test/Evaluate/Inputs/comporder2.mod @@ -0,0 +1,8 @@ +!mod$ v1 sum:3235f4a02cdad423 +!need$ 64657f78d85da21d n comporder1 +module comporder2 +use comporder1,only:base +type,extends(base)::intermediate +integer(4)::c2 +end type +end diff --git a/flang/test/Evaluate/comporder.f90 b/flang/test/Evaluate/comporder.f90 new file mode 100644 index 0000000000000..c57f68137e11b --- /dev/null +++ b/flang/test/Evaluate/comporder.f90 @@ -0,0 +1,41 @@ +!RUN: %flang_fc1 -fdebug-unparse -I%S/Inputs %s | FileCheck %s +program main + use comporder2 + type, extends(intermediate) :: last + integer c3 + end type + !CHECK:PRINT *, last(c1=1_4,c2=2_4,c3=3_4) + print *, last(1,2,3) + !CHECK:PRINT *, last(c1=11_4,c2=12_4,c3=13_4) + print *, last(c3=13,c2=12,c1=11) + !CHECK:PRINT *, last(c1=21_4,c2=22_4,c3=23_4) + print *, last(c3=23,c1=21,c2=22) + !CHECK:PRINT *, last(c1=31_4,c2=32_4,c3=33_4) + print *, last(c2=32,c3=33,c1=31) + !CHECK:PRINT *, last(c1=41_4,c2=42_4,c3=43_4) + print *, last(c2=42,c1=41,c3=43) + !CHECK:PRINT *, last(c1=51_4,c2=52_4,c3=53_4) + print *, last(c1=51,c3=53,c2=52) + !CHECK:PRINT *, last(c1=61_4,c2=62_4,c3=63_4) + print *, last(c1=61,c2=62,c3=63) + !CHECK:PRINT *, last(intermediate=intermediate(c1=71_4,c2=72_4),c3=73_4) + print *, last(c3=73,intermediate=intermediate(c2=72,c1=71)) + !CHECK:PRINT *, last(intermediate=intermediate(c1=81_4,c2=82_4),c3=83_4) + print *, last(c3=83,intermediate=intermediate(c1=81,c2=82)) + !CHECK:PRINT *, last(intermediate=intermediate(c1=91_4,c2=92_4),c3=93_4) + print *, last(intermediate(c2=92,c1=91),c3=93) + !CHECK:PRINT *, last(intermediate=intermediate(c1=101_4,c2=102_4),c3=103_4) + print *, last(intermediate(c1=101,c2=102),c3=103) + !CHECK:PRINT *, last(intermediate=intermediate(base=base(c1=111_4),c2=112_4),c3=113_4) + print *, last(c3=113,intermediate=intermediate(c2=112,base=base(c1=111))) + !CHECK:PRINT *, last(intermediate=intermediate(base=base(c1=121_4),c2=122_4),c3=123_4) + print *, last(c3=123,intermediate=intermediate(base(c1=121),c2=122)) + !CHECK:PRINT *, last(intermediate=intermediate(base=base(c1=131_4),c2=132_4),c3=133_4) + print *, last(intermediate(c2=132,base=base(c1=131)),c3=133) + !CHECK:PRINT *, last(intermediate=intermediate(base=base(c1=141_4),c2=142_4),c3=143_4) + print *, last(intermediate(base(c1=141),c2=142),c3=143) + !CHECK:PRINT *, last(base=base(c1=151_4),c2=152_4,c3=153_4) + print *, last(base(151),c3=153,c2=152) + !CHECK:PRINT *, last(base=base(c1=161_4),c2=162_4,c3=163_4) + print *, last(base(161),c2=162,c3=163) +end