From 2d6e280223cca4e44882245feb06e0c50d4c6375 Mon Sep 17 00:00:00 2001
From: Peixin Qiao <qiaopeixin@huawei.com>
Date: Wed, 11 Jan 2023 20:55:15 +0800
Subject: [PATCH] [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
---
 flang/lib/Semantics/check-declarations.cpp | 31 +++++++++++++++++++
 flang/test/Semantics/bind-c09.f90          | 49 ++++++++++++++++++++++++++++++
 2 files changed, 80 insertions(+)
 create mode 100644 flang/test/Semantics/bind-c09.f90

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index f9eab21..636410d 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -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)) {
diff --git a/flang/test/Semantics/bind-c09.f90 b/flang/test/Semantics/bind-c09.f90
new file mode 100644
index 0000000..fe19720
--- /dev/null
+++ b/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
-- 
2.7.4