[flang] Support C1553 about BIND(C) function result

As Fortran 2018 C1553, if with BIND(C), the function result shall be an
interoperable scalar variable. As Fortran 2018 18.3.4(1), the
interoperable scalar variable is not a coarray, has neither the
ALLOCATABLE nor the POINTER attribute, and if it is of type character its
length is not assumed or declared by an expression that is not a constant
expression.

As Fortran 2018 18.3.1(1), if the type is character, the length type
parameter is interoperable if and only if its value is one.

Reviewed By: PeteSteinfeld, jeanPerier

Differential Revision: https://reviews.llvm.org/D137254
This commit is contained in:
Peixin Qiao 2023-01-11 20:55:15 +08:00
parent 800f0f1546
commit 2d6e280223
2 changed files with 80 additions and 0 deletions

View File

@ -114,6 +114,7 @@ private:
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckBindC(const Symbol &);
void CheckBindCFunctionResult(const Symbol &);
// Check functions for defined I/O procedures
void CheckDefinedIoProc(
const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
@ -399,6 +400,7 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"A function result may not have the SAVE attribute"_err_en_US);
}
CheckBindCFunctionResult(symbol);
}
if (symbol.owner().IsDerivedType() &&
(symbol.attrs().test(Attr::CONTIGUOUS) &&
@ -416,6 +418,35 @@ void CheckHelper::Check(const Symbol &symbol) {
void CheckHelper::CheckCommonBlock(const Symbol &symbol) { CheckBindC(symbol); }
void CheckHelper::CheckBindCFunctionResult(const Symbol &symbol) { // C1553
if (!innermostSymbol_ || !IsBindCProcedure(*innermostSymbol_)) {
return;
}
if (IsPointer(symbol) || IsAllocatable(symbol)) {
messages_.Say(
"BIND(C) function result cannot have ALLOCATABLE or POINTER attribute"_err_en_US);
}
if (const DeclTypeSpec * type{symbol.GetType()};
type && type->category() == DeclTypeSpec::Character) {
bool isConstOne{false}; // 18.3.1(1)
if (const auto &len{type->characterTypeSpec().length().GetExplicit()}) {
if (auto constLen{evaluate::ToInt64(*len)}) {
isConstOne = constLen == 1;
}
}
if (!isConstOne) {
messages_.Say(
"BIND(C) character function result must have length one"_err_en_US);
}
}
if (symbol.Rank() > 0) {
messages_.Say("BIND(C) function result must be scalar"_err_en_US);
}
if (symbol.Corank()) {
messages_.Say("BIND(C) function result cannot be a coarray"_err_en_US);
}
}
void CheckHelper::CheckValue(
const Symbol &symbol, const DerivedTypeSpec *derived) { // C863 - C865
if (!IsDummy(symbol)) {

View File

@ -0,0 +1,49 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
! Check for C1553 and 18.3.4(1)
function func1() result(res) bind(c)
! ERROR: BIND(C) function result cannot have ALLOCATABLE or POINTER attribute
integer, pointer :: res
end
function func2() result(res) bind(c)
! ERROR: BIND(C) function result cannot have ALLOCATABLE or POINTER attribute
integer, allocatable :: res
end
function func3() result(res) bind(c)
! ERROR: BIND(C) function result must be scalar
integer :: res(2)
end
function func4() result(res) bind(c)
! ERROR: BIND(C) character function result must have length one
character(*) :: res
end
function func5(n) result(res) bind(c)
integer :: n
! ERROR: BIND(C) character function result must have length one
character(n) :: res
end
function func6() result(res) bind(c)
! ERROR: BIND(C) character function result must have length one
character(2) :: res
end
function func7() result(res) bind(c)
integer, parameter :: n = 1
character(n) :: res ! OK
end
function func8() result(res) bind(c)
! ERROR: BIND(C) function result cannot have ALLOCATABLE or POINTER attribute
! ERROR: BIND(C) character function result must have length one
character(:), pointer :: res
end
function func9() result(res) bind(c)
! ERROR: BIND(C) function result cannot be a coarray
integer :: res[10, *]
end