Revert "[flang] Improve constant folding for type parameter inquiries"
This reverts commit 8c7bf2f93da9b64b07509f67552d592a86260ff5.
GitOrigin-RevId: b7ef804807855e607da3eba221c1fc59e27f778e
diff --git a/lib/Evaluate/fold-integer.cpp b/lib/Evaluate/fold-integer.cpp
index 8b39ee0..eea7b6e 100644
--- a/lib/Evaluate/fold-integer.cpp
+++ b/lib/Evaluate/fold-integer.cpp
@@ -658,43 +658,24 @@
// Substitute a bare type parameter reference with its value if it has one now
Expr<TypeParamInquiry::Result> FoldOperation(
FoldingContext &context, TypeParamInquiry &&inquiry) {
- std::optional<NamedEntity> base{inquiry.base()};
- parser::CharBlock parameterName{inquiry.parameter().name()};
- if (base) {
- // Handling "designator%typeParam". Get the value of the type parameter
- // from the instantiation of the base
- if (const semantics::DeclTypeSpec *
- declType{base->GetLastSymbol().GetType()}) {
- const semantics::DerivedTypeSpec dType{declType->derivedTypeSpec()};
- if (const semantics::ParamValue *
- paramValue{dType.FindParameter(parameterName)}) {
- const semantics::MaybeIntExpr ¶mExpr{paramValue->GetExplicit()};
- if (paramExpr && IsConstantExpr(*paramExpr)) {
- Expr<SomeInteger> intExpr{*paramExpr};
- return Fold(context,
- ConvertToType<TypeParamInquiry::Result>(std::move(intExpr)));
- }
- }
- }
- } else {
+ if (!inquiry.base()) {
// A "bare" type parameter: replace with its value, if that's now known.
if (const auto *pdt{context.pdtInstance()}) {
if (const semantics::Scope * scope{context.pdtInstance()->scope()}) {
- auto iter{scope->find(parameterName)};
+ auto iter{scope->find(inquiry.parameter().name())};
if (iter != scope->end()) {
const Symbol &symbol{*iter->second};
const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()};
- if (details) {
- const semantics::MaybeIntExpr &initExpr{details->init()};
- if (initExpr && IsConstantExpr(*initExpr)) {
- Expr<SomeInteger> expr{*initExpr};
- return Fold(context,
- ConvertToType<TypeParamInquiry::Result>(std::move(expr)));
- }
+ if (details && details->init() &&
+ (details->attr() == common::TypeParamAttr::Kind ||
+ IsConstantExpr(*details->init()))) {
+ Expr<SomeInteger> expr{*details->init()};
+ return Fold(context,
+ ConvertToType<TypeParamInquiry::Result>(std::move(expr)));
}
}
}
- if (const auto *value{pdt->FindParameter(parameterName)}) {
+ if (const auto *value{pdt->FindParameter(inquiry.parameter().name())}) {
if (value->isExplicit()) {
return Fold(context,
AsExpr(ConvertToType<TypeParamInquiry::Result>(
diff --git a/lib/Evaluate/formatting.cpp b/lib/Evaluate/formatting.cpp
index f7cfaa3..df3671a 100644
--- a/lib/Evaluate/formatting.cpp
+++ b/lib/Evaluate/formatting.cpp
@@ -614,7 +614,7 @@
llvm::raw_ostream &TypeParamInquiry::AsFortran(llvm::raw_ostream &o) const {
if (base_) {
- base_.value().AsFortran(o) << '%';
+ return base_->AsFortran(o) << '%';
}
return EmitVar(o, parameter_);
}
diff --git a/lib/Semantics/type.cpp b/lib/Semantics/type.cpp
index c548b5c..741b253 100644
--- a/lib/Semantics/type.cpp
+++ b/lib/Semantics/type.cpp
@@ -205,8 +205,7 @@
}
void InstantiateComponent(const Symbol &);
const DeclTypeSpec *InstantiateType(const Symbol &);
- const DeclTypeSpec &InstantiateIntrinsicType(
- SourceName, const DeclTypeSpec &);
+ const DeclTypeSpec &InstantiateIntrinsicType(const DeclTypeSpec &);
DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool);
SemanticsContext &context_;
@@ -365,7 +364,7 @@
CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)),
context_, type->category());
} else if (type->AsIntrinsic()) {
- return &InstantiateIntrinsicType(symbol.name(), *type);
+ return &InstantiateIntrinsicType(*type);
} else if (type->category() == DeclTypeSpec::ClassStar) {
return type;
} else {
@@ -375,7 +374,7 @@
// Apply type parameter values to an intrinsic type spec.
const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
- SourceName symbolName, const DeclTypeSpec &spec) {
+ const DeclTypeSpec &spec) {
const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
if (evaluate::ToInt64(intrinsic.kind())) {
return spec; // KIND is already a known constant
@@ -388,7 +387,7 @@
if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) {
kind = *value;
} else {
- foldingContext().messages().Say(symbolName,
+ foldingContext().messages().Say(
"KIND parameter value (%jd) of intrinsic type %s "
"did not resolve to a supported value"_err_en_US,
*value,
diff --git a/test/Semantics/assign04.f90 b/test/Semantics/assign04.f90
index 7cb30c4..a88c3a5 100644
--- a/test/Semantics/assign04.f90
+++ b/test/Semantics/assign04.f90
@@ -8,7 +8,7 @@
type(t(1, 2)) :: x
!ERROR: Assignment to constant 'x%k' is not allowed
x%k = 4
- !ERROR: Assignment to constant 'x%l' is not allowed
+ !ERROR: Left-hand side of assignment is not modifiable
x%l = 3
end
diff --git a/test/Semantics/resolve104.f90 b/test/Semantics/resolve104.f90
deleted file mode 100644
index 176c9d6..0000000
--- a/test/Semantics/resolve104.f90
+++ /dev/null
@@ -1,64 +0,0 @@
-! RUN: %S/test_errors.sh %s %t %f18
-! Test constant folding of type parameter values both a base value and a
-! parameter name are supplied.
-!
-! Type parameters are described in 7.5.3 and constant expressions are described
-! in 10.1.12. 10.1.12, paragraph 4 defines whether a specification inquiry is
-! a constant expression. Section 10.1.11, paragraph 3, item (2) states that a
-! type parameter inquiry is a specification inquiry.
-
-module m1
- type dtype(goodDefaultKind, badDefaultKind)
- integer, kind :: goodDefaultKind = 4
- integer, kind :: badDefaultKind = 343
- ! next field OK only if instantiated with a good value of goodDefaultKind
- !ERROR: KIND parameter value (99) of intrinsic type REAL did not resolve to a supported value
- real(goodDefaultKind) :: goodDefaultField
- ! next field OK only if instantiated with a good value of goodDefaultKind
- !ERROR: KIND parameter value (343) of intrinsic type REAL did not resolve to a supported value
- !ERROR: KIND parameter value (99) of intrinsic type REAL did not resolve to a supported value
- real(badDefaultKind) :: badDefaultField
- end type dtype
- type(dtype) :: v1
- type(dtype(4, 4)) :: v2
- type(dtype(99, 4)) :: v3
- type(dtype(4, 99)) :: v4
-end module m1
-
-module m2
- type baseType(baseParam)
- integer, kind :: baseParam = 4
- end type baseType
- type dtype(dtypeParam)
- integer, kind :: dtypeParam = 4
- type(baseType(dtypeParam)) :: baseField
- !ERROR: KIND parameter value (343) of intrinsic type REAL did not resolve to a supported value
- real(baseField%baseParam) :: realField
- end type dtype
-
- type(dtype) :: v1
- type(dtype(8)) :: v2
- type(dtype(343)) :: v3
-end module m2
-
-module m3
- type dtype(goodDefaultLen, badDefaultLen)
- integer, len :: goodDefaultLen = 4
- integer, len :: badDefaultLen = 343
- end type dtype
- type(dtype) :: v1
- type(dtype(4, 4)) :: v2
- type(dtype(99, 4)) :: v3
- type(dtype(4, 99)) :: v4
- real(v1%goodDefaultLen), pointer :: pGood1
- !ERROR: REAL(KIND=343) is not a supported type
- real(v1%badDefaultLen), pointer :: pBad1
- real(v2%goodDefaultLen), pointer :: pGood2
- real(v2%badDefaultLen), pointer :: pBad2
- !ERROR: REAL(KIND=99) is not a supported type
- real(v3%goodDefaultLen), pointer :: pGood3
- real(v3%badDefaultLen), pointer :: pBad3
- real(v4%goodDefaultLen), pointer :: pGood4
- !ERROR: REAL(KIND=99) is not a supported type
- real(v4%badDefaultLen), pointer :: pBad4
-end module m3
diff --git a/test/Semantics/resolve89.f90 b/test/Semantics/resolve89.f90
index eaa902b..f3bf218 100644
--- a/test/Semantics/resolve89.f90
+++ b/test/Semantics/resolve89.f90
@@ -107,7 +107,7 @@
type localDerivedType
! OK because the specification inquiry is a constant
integer, dimension(localDerived%kindParam) :: goodField
- ! OK because the value of lenParam is constant in this context
+ !ERROR: Invalid specification expression: non-constant reference to a type parameter inquiry not allowed for derived type components or type parameter values
integer, dimension(derivedArg%lenParam) :: badField
end type localDerivedType
