29 changes: 7 additions & 22 deletions flang/test/Lower/select-case-statement.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -176,9 +176,6 @@ subroutine scharacter1(s)
! CHECK: %[[V_20:[0-9]+]] = fir.box_addr %[[V_18]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
! CHECK: %[[V_42:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_43:[0-9]+]] = arith.cmpi eq, %[[V_42]], %c0{{.*}} : i32
! CHECK: fir.if %[[V_43]] {
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: }
! CHECK: cond_br %[[V_43]], ^bb3, ^bb2
! CHECK: ^bb2: // pred: ^bb1
select case(trim(s))
Expand All @@ -190,9 +187,6 @@ subroutine scharacter1(s)

! CHECK: %[[V_48:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_49:[0-9]+]] = arith.cmpi eq, %[[V_48]], %c0{{.*}} : i32
! CHECK: fir.if %[[V_49]] {
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: }
! CHECK: cond_br %[[V_49]], ^bb6, ^bb5
! CHECK: ^bb3: // pred: ^bb1
! CHECK: fir.store %c1{{.*}} to %[[V_1]] : !fir.ref<i32>
Expand All @@ -203,9 +197,6 @@ subroutine scharacter1(s)

! CHECK: %[[V_54:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_55:[0-9]+]] = arith.cmpi eq, %[[V_54]], %c0{{.*}} : i32
! CHECK: fir.if %[[V_55]] {
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: }
! CHECK: cond_br %[[V_55]], ^bb8, ^bb7
! CHECK: ^bb6: // pred: ^bb2
! CHECK: fir.store %c2{{.*}} to %[[V_1]] : !fir.ref<i32>
Expand All @@ -223,9 +214,6 @@ subroutine scharacter1(s)
! CHECK: ^bb9: // pred: ^bb7
! CHECK: %[[V_66:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_67:[0-9]+]] = arith.cmpi sle, %[[V_66]], %c0{{.*}} : i32
! CHECK: fir.if %[[V_67]] {
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: }
! CHECK: cond_br %[[V_67]], ^bb14, ^bb10
! CHECK: ^bb10: // 2 preds: ^bb7, ^bb9
! CHECK: %[[V_72:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
Expand All @@ -234,18 +222,15 @@ subroutine scharacter1(s)
! CHECK: ^bb11: // pred: ^bb10
! CHECK: %[[V_78:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_79:[0-9]+]] = arith.cmpi sle, %[[V_78]], %c0{{.*}} : i32
! CHECK: fir.if %[[V_79]] {
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: }
! CHECK: ^bb12: // 2 preds: ^bb10, ^bb11
! CHECK: %[[V_84:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_85:[0-9]+]] = arith.cmpi sge, %[[V_84]], %c0{{.*}} : i32
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: cond_br %[[V_85]], ^bb14, ^bb13
! CHECK: ^bb13: // pred: ^bb12
! CHECK: ^bb14: // 3 preds: ^bb9, ^bb11, ^bb12
! CHECK: fir.store %c4{{.*}} to %[[V_1]] : !fir.ref<i32>
! CHECK: ^bb15: // 5 preds: ^bb3, ^bb4, ^bb6, ^bb8, ^bb14
! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
end select
end if
! CHECK: %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
Expand All @@ -257,28 +242,28 @@ subroutine scharacter2(s)
! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
character(len=3) :: s
n = 0

n = -10
! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
! CHECK: %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
! CHECK: br ^bb1
! CHECK: ^bb1: // pred: ^bb0
! CHECK: fir.store %c9{{.*}}
! CHECK: br ^bb2
n = -10
! CHECK: ^bb2: // pred: ^bb1
! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
select case(trim(s))
case default
n = 9
end select
print*, n

! CHECK: ^bb2: // pred: ^bb1
n = -2
! CHECK: %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
! CHECK: %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
! CHECK: br ^bb3
! CHECK: ^bb3: // pred: ^bb2
n = -2
! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
select case(trim(s))
end select
print*, n
Expand Down
118 changes: 51 additions & 67 deletions flang/unittests/Optimizer/InternalNamesTest.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,23 +16,23 @@ using llvm::SmallVector;
using llvm::StringRef;

struct DeconstructedName {
DeconstructedName(llvm::StringRef name) : name{name} {}
DeconstructedName(llvm::ArrayRef<std::string> modules,
std::optional<std::string> host, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds)
: modules{modules.begin(), modules.end()}, host{host}, name{name},
kinds{kinds.begin(), kinds.end()} {}
llvm::ArrayRef<std::string> procs, std::int64_t blockId,
llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds)
: modules{modules.begin(), modules.end()}, procs{procs.begin(),
procs.end()},
blockId{blockId}, name{name}, kinds{kinds.begin(), kinds.end()} {}

bool isObjEqual(const NameUniquer::DeconstructedName &actualObj) {
if ((actualObj.name == name) && (actualObj.modules == modules) &&
(actualObj.host == host) && (actualObj.kinds == kinds)) {
return true;
}
return false;
return actualObj.modules == modules && actualObj.procs == procs &&
actualObj.blockId == blockId && actualObj.name == name &&
actualObj.kinds == kinds;
}

private:
llvm::SmallVector<std::string> modules;
std::optional<std::string> host;
llvm::SmallVector<std::string> procs;
std::int64_t blockId;
std::string name;
llvm::SmallVector<std::int64_t> kinds;
};
Expand All @@ -47,20 +47,11 @@ void validateDeconstructedName(
<< "Possible error: DeconstructedName mismatch";
}

TEST(InternalNamesTest, doBlockDataTest) {
std::string actual = NameUniquer::doBlockData("blockdatatest");
std::string actualBlank = NameUniquer::doBlockData("");
std::string expectedMangledName = "_QLblockdatatest";
std::string expectedMangledNameBlank = "_QL";
ASSERT_EQ(actual, expectedMangledName);
ASSERT_EQ(actualBlank, expectedMangledNameBlank);
}

TEST(InternalNamesTest, doCommonBlockTest) {
std::string actual = NameUniquer::doCommonBlock("hello");
std::string actualBlank = NameUniquer::doCommonBlock("");
std::string expectedMangledName = "_QBhello";
std::string expectedMangledNameBlank = "_QB";
std::string expectedMangledName = "_QChello";
std::string expectedMangledNameBlank = "_QC";
ASSERT_EQ(actual, expectedMangledName);
ASSERT_EQ(actualBlank, expectedMangledNameBlank);
}
Expand All @@ -81,7 +72,7 @@ TEST(InternalNamesTest, doGeneratedTest) {

TEST(InternalNamesTest, doConstantTest) {
std::string actual =
NameUniquer::doConstant({"mod1", "mod2"}, {"foo"}, "Hello");
NameUniquer::doConstant({"mod1", "mod2"}, {"foo"}, 0, "Hello");
std::string expectedMangledName = "_QMmod1Smod2FfooEChello";
ASSERT_EQ(actual, expectedMangledName);
}
Expand All @@ -93,66 +84,59 @@ TEST(InternalNamesTest, doProcedureTest) {
}

TEST(InternalNamesTest, doTypeTest) {
std::string actual = NameUniquer::doType({}, {}, "mytype", {4, -1});
std::string actual = NameUniquer::doType({}, {}, 0, "mytype", {4, -1});
std::string expectedMangledName = "_QTmytypeK4KN1";
ASSERT_EQ(actual, expectedMangledName);
}

TEST(InternalNamesTest, doIntrinsicTypeDescriptorTest) {
using IntrinsicType = fir::NameUniquer::IntrinsicType;
std::string actual =
NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, 42);
std::string expectedMangledName = "_QCrealK42";
std::string actual = NameUniquer::doIntrinsicTypeDescriptor(
{}, {}, 0, IntrinsicType::REAL, 42);
std::string expectedMangledName = "_QYIrealK42";
ASSERT_EQ(actual, expectedMangledName);

actual =
NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, {});
expectedMangledName = "_QCrealK0";
actual = NameUniquer::doIntrinsicTypeDescriptor(
{}, {}, 0, IntrinsicType::REAL, {});
expectedMangledName = "_QYIrealK0";
ASSERT_EQ(actual, expectedMangledName);

actual =
NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::INTEGER, 3);
expectedMangledName = "_QCintegerK3";
actual = NameUniquer::doIntrinsicTypeDescriptor(
{}, {}, 0, IntrinsicType::INTEGER, 3);
expectedMangledName = "_QYIintegerK3";
ASSERT_EQ(actual, expectedMangledName);

actual =
NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::LOGICAL, 2);
expectedMangledName = "_QClogicalK2";
actual = NameUniquer::doIntrinsicTypeDescriptor(
{}, {}, 0, IntrinsicType::LOGICAL, 2);
expectedMangledName = "_QYIlogicalK2";
ASSERT_EQ(actual, expectedMangledName);

actual = NameUniquer::doIntrinsicTypeDescriptor(
{}, {}, IntrinsicType::CHARACTER, 4);
expectedMangledName = "_QCcharacterK4";
{}, {}, 0, IntrinsicType::CHARACTER, 4);
expectedMangledName = "_QYIcharacterK4";
ASSERT_EQ(actual, expectedMangledName);

actual =
NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::COMPLEX, 4);
expectedMangledName = "_QCcomplexK4";
actual = NameUniquer::doIntrinsicTypeDescriptor(
{}, {}, 0, IntrinsicType::COMPLEX, 4);
expectedMangledName = "_QYIcomplexK4";
ASSERT_EQ(actual, expectedMangledName);
}

TEST(InternalNamesTest, doDispatchTableTest) {
std::string actual =
NameUniquer::doDispatchTable({}, {}, "MyTYPE", {2, 8, 18});
NameUniquer::doDispatchTable({}, {}, 0, "MyTYPE", {2, 8, 18});
std::string expectedMangledName = "_QDTmytypeK2K8K18";
ASSERT_EQ(actual, expectedMangledName);
}

TEST(InternalNamesTest, doTypeDescriptorTest) {
std::string actual = NameUniquer::doTypeDescriptor(
{StringRef("moD1")}, {StringRef("foo")}, "MyTYPE", {2, 8});
std::string expectedMangledName = "_QMmod1FfooCTmytypeK2K8";
ASSERT_EQ(actual, expectedMangledName);
}

TEST(InternalNamesTest, doVariableTest) {
std::string actual = NameUniquer::doVariable(
{"mod1", "mod2"}, {""}, "intvar"); // Function is present and is blank.
{"mod1", "mod2"}, {""}, 0, "intvar"); // Function is present and is blank.
std::string expectedMangledName = "_QMmod1Smod2FEintvar";
ASSERT_EQ(actual, expectedMangledName);

std::string actual2 = NameUniquer::doVariable(
{"mod1", "mod2"}, {}, "intVariable"); // Function is not present.
{"mod1", "mod2"}, {}, 0, "intVariable"); // Function is not present.
std::string expectedMangledName2 = "_QMmod1Smod2Eintvariable";
ASSERT_EQ(actual2, expectedMangledName2);
}
Expand All @@ -165,15 +149,15 @@ TEST(InternalNamesTest, doProgramEntry) {

TEST(InternalNamesTest, doNamelistGroup) {
std::string actual = NameUniquer::doNamelistGroup({"mod1"}, {}, "nlg");
std::string expectedMangledName = "_QMmod1Gnlg";
std::string expectedMangledName = "_QMmod1Nnlg";
ASSERT_EQ(actual, expectedMangledName);
}

TEST(InternalNamesTest, deconstructTest) {
std::pair actual = NameUniquer::deconstruct("_QBhello");
std::pair actual = NameUniquer::deconstruct("_QChello");
auto expectedNameKind = NameUniquer::NameKind::COMMON;
struct DeconstructedName expectedComponents {
{}, {}, "hello", {}
{}, {}, 0, "hello", {}
};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
}
Expand All @@ -183,42 +167,42 @@ TEST(InternalNamesTest, complexdeconstructTest) {
std::pair actual = NameUniquer::deconstruct("_QMmodSs1modSs2modFsubPfun");
auto expectedNameKind = NameKind::PROCEDURE;
struct DeconstructedName expectedComponents = {
{"mod", "s1mod", "s2mod"}, {"sub"}, "fun", {}};
{"mod", "s1mod", "s2mod"}, {"sub"}, 0, "fun", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QPsub");
expectedNameKind = NameKind::PROCEDURE;
expectedComponents = {{}, {}, "sub", {}};
expectedComponents = {{}, {}, 0, "sub", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QBvariables");
actual = NameUniquer::deconstruct("_QCvariables");
expectedNameKind = NameKind::COMMON;
expectedComponents = {{}, {}, "variables", {}};
expectedComponents = {{}, {}, 0, "variables", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QMmodEintvar");
expectedNameKind = NameKind::VARIABLE;
expectedComponents = {{"mod"}, {}, "intvar", {}};
expectedComponents = {{"mod"}, {}, 0, "intvar", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QMmodECpi");
expectedNameKind = NameKind::CONSTANT;
expectedComponents = {{"mod"}, {}, "pi", {}};
expectedComponents = {{"mod"}, {}, 0, "pi", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QTyourtypeK4KN6");
expectedNameKind = NameKind::DERIVED_TYPE;
expectedComponents = {{}, {}, "yourtype", {4, -6}};
expectedComponents = {{}, {}, 0, "yourtype", {4, -6}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QDTt");
expectedNameKind = NameKind::DISPATCH_TABLE;
expectedComponents = {{}, {}, "t", {}};
expectedComponents = {{}, {}, 0, "t", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);

actual = NameUniquer::deconstruct("_QFmstartGmpitop");
actual = NameUniquer::deconstruct("_QFmstartNmpitop");
expectedNameKind = NameKind::NAMELIST_GROUP;
expectedComponents = {{}, {"mstart"}, "mpitop", {}};
expectedComponents = {{}, {"mstart"}, 0, "mpitop", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
}

Expand All @@ -230,10 +214,10 @@ TEST(InternalNamesTest, needExternalNameMangling) {
ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QDTmytypeK2K8K18"));
ASSERT_FALSE(NameUniquer::needExternalNameMangling("exit_"));
ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QFfooEx"));
ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QFmstartGmpitop"));
ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QFmstartNmpitop"));
ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPfoo"));
ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPbar"));
ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QBa"));
ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QCa"));
}

TEST(InternalNamesTest, isExternalFacingUniquedName) {
Expand All @@ -252,7 +236,7 @@ TEST(InternalNamesTest, isExternalFacingUniquedName) {
ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
result = NameUniquer::deconstruct("_QPbar");
ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
result = NameUniquer::deconstruct("_QBa");
result = NameUniquer::deconstruct("_QCa");
ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
}

Expand Down