Skip to content

Commit

Permalink
[flang] Support C1553 about BIND(C) function result
Browse files Browse the repository at this point in the history
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
  • Loading branch information
PeixinQiao committed Jan 11, 2023
1 parent 800f0f1 commit 2d6e280
Show file tree
Hide file tree
Showing 2 changed files with 80 additions and 0 deletions.
31 changes: 31 additions & 0 deletions flang/lib/Semantics/check-declarations.cpp
Expand Up @@ -114,6 +114,7 @@ class CheckHelper {
}
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);
Expand Down Expand Up @@ -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) &&
Expand All @@ -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)) {
Expand Down
49 changes: 49 additions & 0 deletions flang/test/Semantics/bind-c09.f90
@@ -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

0 comments on commit 2d6e280

Please sign in to comment.