}
}
}
- context.Say("KIND type parameter on literal must be a scalar "
- "integer constant"_err_en_US);
return defaultKind;
},
[&](parser::KindParam::Kanji) {
AnalyzeKindParam(context, std::get<std::optional<parser::KindParam>>(x.t),
context.GetDefaultKind(TypeCategory::Integer))};
auto value{std::get<0>(x.t)}; // std::(u)int64_t
- auto result{common::SearchTypes(
- TypeKindVisitor<TypeCategory::Integer, Constant, std::int64_t>{
- kind, static_cast<std::int64_t>(value)})};
- if (!result.has_value()) {
- context.Say("unsupported INTEGER(KIND=%d)"_err_en_US, kind);
+ if (!context.CheckIntrinsicKind(TypeCategory::Integer, kind)) {
+ return std::nullopt;
}
- return result;
+ return common::SearchTypes(
+ TypeKindVisitor<TypeCategory::Integer, Constant, std::int64_t>{
+ kind, static_cast<std::int64_t>(value)});
}
static MaybeExpr AnalyzeExpr(
// CHARACTER literal processing.
static MaybeExpr AnalyzeString(
ExpressionAnalysisContext &context, std::string &&string, int kind) {
- if (!IsValidKindOfIntrinsicType(TypeCategory::Character, kind)) {
- context.Say("unsupported CHARACTER(KIND=%d)"_err_en_US, kind);
+ if (!context.CheckIntrinsicKind(TypeCategory::Character, kind)) {
return std::nullopt;
}
if (kind == 1) {
return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
*kind, AsExpr(ImpliedDoIndex{n.source})));
} else if (n.symbol == nullptr) {
- context.Say(
- n.source, "TODO INTERNAL: name was not resolved to a symbol"_err_en_US);
+ // error should have been reported in name resolution
} else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) {
if (auto *details{n.symbol->detailsIf<semantics::ObjectEntityDetails>()}) {
if (auto &init{details->init()}) {
return init;
}
}
- context.Say(n.source, "parameter does not have a value"_err_en_US);
// TODO: enumerators, do they have the PARAMETER attribute?
} else if (n.symbol->detailsIf<semantics::TypeParamDetails>()) {
// A bare reference to a derived type parameter (within a parameterized
Expr<SomeType> folded{
Fold(GetFoldingContext(), std::move(*kind))};
if (std::optional<std::int64_t> code{ToInt64(folded)}) {
- if (IsValidKindOfIntrinsicType(category, *code)) {
+ if (CheckIntrinsicKind(category, *code)) {
return Expr<SubscriptInteger>{*code};
}
- SayAt(x, "%s(KIND=%jd) is not a supported type"_err_en_US,
- parser::ToUpperCaseLetters(EnumToString(category)).data(),
- *code);
} else if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(folded)}) {
return ConvertToType<SubscriptInteger>(std::move(*intExpr));
}
[&](const parser::KindSelector::StarSize &x)
-> Expr<SubscriptInteger> {
std::intmax_t size = x.v;
- if (category == TypeCategory::Complex) {
- // COMPLEX*16 == COMPLEX(KIND=8)
- if ((size % 2) == 0 &&
- evaluate::IsValidKindOfIntrinsicType(category, size / 2)) {
- size /= 2;
- } else {
- Say("COMPLEX*%jd is not a supported type"_err_en_US, size);
- size = defaultKind;
- }
- } else if (!evaluate::IsValidKindOfIntrinsicType(category, size)) {
- Say("%s*%jd is not a supported type"_err_en_US,
- parser::ToUpperCaseLetters(EnumToString(category)).data(),
- size);
+ if (!CheckIntrinsicSize(category, size)) {
size = defaultKind;
+ } else if (category == TypeCategory::Complex) {
+ size /= 2;
}
return Expr<SubscriptInteger>{size};
},
return {category, GetDefaultKind(category)};
}
+bool ExpressionAnalysisContext::CheckIntrinsicKind(
+ TypeCategory category, std::int64_t kind) {
+ if (IsValidKindOfIntrinsicType(category, kind)) {
+ return true;
+ } else {
+ Say("%s(KIND=%jd) is not a supported type"_err_en_US,
+ parser::ToUpperCaseLetters(EnumToString(category)).data(), kind);
+ return false;
+ }
+}
+
+bool ExpressionAnalysisContext::CheckIntrinsicSize(
+ TypeCategory category, std::int64_t size) {
+ if (category == TypeCategory::Complex) {
+ // COMPLEX*16 == COMPLEX(KIND=8)
+ if (size % 2 == 0 && IsValidKindOfIntrinsicType(category, size / 2)) {
+ return true;
+ }
+ } else if (IsValidKindOfIntrinsicType(category, size)) {
+ return true;
+ }
+ Say("%s*%jd is not a supported type"_err_en_US,
+ parser::ToUpperCaseLetters(EnumToString(category)).data(), size);
+ return false;
+}
+
bool ExpressionAnalysisContext::AddAcImpliedDo(
parser::CharBlock name, int kind) {
return acImpliedDos_.insert(std::make_pair(name, kind)).second;
void Post(const parser::CharSelector::LengthAndKind &);
void Post(const parser::CharLength &);
void Post(const parser::LengthSelector &);
+ bool Pre(const parser::KindParam &);
bool Pre(const parser::DeclarationTypeSpec::Type &);
bool Pre(const parser::DeclarationTypeSpec::Class &);
bool Pre(const parser::DeclarationTypeSpec::Record &);
symbol.get<ObjectEntityDetails>().set_init(EvaluateExpr(*expr));
}
}
+ } else if (attrs.test(Attr::PARAMETER)) {
+ Say(name, "Missing initialization for parameter '%s'"_err_en_US);
}
}
}
}
+bool DeclarationVisitor::Pre(const parser::KindParam &x) {
+ if (const auto *kind{std::get_if<
+ parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(
+ &x.u)}) {
+ const parser::Name &name{kind->thing.thing.thing};
+ if (!FindSymbol(name)) {
+ Say(name, "Parameter '%s' not found"_err_en_US);
+ }
+ }
+ return false;
+}
+
bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &x) {
CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);
return true;
--- /dev/null
+! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+! http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! Check modfile generation for generic interfaces
+module m
+ integer, parameter :: k8 = 8
+ integer(8), parameter :: k4 = k8/2
+ integer, parameter :: k1 = 1
+ integer(k8), parameter :: i = 2_k8
+ real :: r = 2.0_k4
+ character(10, kind=k1) :: c = k1_"asdf"
+ complex*16 :: z = (1.0_k8, 2.0_k8)
+end
+
+!Expect: m.mod
+!module m
+! integer(4),parameter::k8=8_4
+! integer(8),parameter::k4=4_4
+! integer(4),parameter::k1=1_4
+! integer(8),parameter::i=2_8
+! real(4)::r=2._4
+! character(10_4,1)::c=1_"asdf"
+! complex(8)::z=(1._8,2._8)
+!end
--- /dev/null
+! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+! http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+module m
+ implicit none
+ real, parameter :: a = 8.0
+ !ERROR: Must have INTEGER type
+ integer :: aa = 2_a
+ integer :: b = 8
+ !ERROR: Must be a constant value
+ integer :: bb = 2_b
+ !TODO: should get error -- not scalar
+ !integer, parameter :: c(10) = 8
+ !integer :: cc = 2_c
+ integer, parameter :: d = 47
+ !ERROR: INTEGER(KIND=47) is not a supported type
+ integer :: dd = 2_d
+ !ERROR: Parameter 'e' not found
+ integer :: ee = 2_e
+ !ERROR: Missing initialization for parameter 'f'
+ integer, parameter :: f
+ integer :: ff = 2_f
+ !ERROR: REAL(KIND=23) is not a supported type
+ real(d/2) :: g
+ !ERROR: REAL*47 is not a supported type
+ real*47 :: h
+ !ERROR: COMPLEX*47 is not a supported type
+ complex*47 :: i
+end
projects / platform / upstream / llvm.git / commitdiff