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

[peixin]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[jeanPerier]

flang/lib/Semantics/check-declarations.cpp

438

Thanks for adding the check. I think that when it comes to the function result, a character can only be interoperable if its length is 1. I think character arguments are more relaxed because a character scalar can be sequence associated (15.5.2.11) to a character array that is interoperable with a char[]. 15.5.2.11 does not apply to result however as far as I know.

I find the standard not cristal clear here. But I am not quite sure how the interoperability of a character(10) result would work in practice for instance. What do you think ?

[peixin]

flang/lib/Semantics/check-declarations.cpp

438

I find the standard not cristal clear here.

It's true that character arguments can be sequence associated. And it should be OK to pass it to one C string. One problem is that C string should have one character '\0' at the end position, but Fortran does not have. So it is not safe to support it.

Please check 18.3.1 (1): If the type is character, the length type parameter is interoperable if and only if its value is one. gfortran and ifort do not allow character length more than 1 for both argument and function result.

So should we enforce the length 1 for both argument and function result?

[peixin]

flang/lib/Semantics/check-declarations.cpp

438

@jeanPerier Can we also enforce the length 1 of character for BIND(C) procedure?

[jeanPerier]

flang/lib/Semantics/check-declarations.cpp

438

Sorry for the late reply, yes, I think we should.

[peixin]

Enforce character length 1 for BIND(C) procedure.

[peixin]

ping @jeanPerier

[jeanPerier]

Sorry for the delay, I am bad at watching already approved patches. My main comment is I think this would now reject legal program because of the dummy check.

flang/lib/Semantics/check-declarations.cpp

401

The message seems a bit complex to me. What about BIND(C) character function result must have length one ? @PeteSteinfeld for opinion.

404

I do not think all BIND(C) character must have length one. I think this only holds true if the argument has the VALUE attribute.

Otherwise, 18.3.6 tells:

(5) any dummy argument without the VALUE attribute corresponds to a formal parameter of the prototype
that is of a pointer type, and [...] the dummy argument is a nonallocatable nonpointer variable of type CHARACTER with assumed character length and the formal parameter is a pointer to CFI_cdesc_t,
[...]
(6) each allocatable or pointer dummy argument of type CHARACTER has deferred character length
`

It bothers me a little because this means that 18.3.4 and 18.3.5 do not apply to dummy objects, which is not very clear IMHO, but I do not think any error should be raised for:

subroutine foo(c1, c2, c3, p1, p2) bind(c)
  character(*) :: c1, c2(:), c3(100)
  character(:), pointer :: p1, p2(:)
end subroutine

[peixin]

flang/lib/Semantics/check-declarations.cpp

404

Thanks for this check. I did some more investigations and have the following results:

1. gfortran 11.3.0 and early version do not support assumed-length or deferred-length character scalar (https://godbolt.org/z/GY3869j11). But from gfortran 12, these two are supported. ifort 2021.7.1 and ifx 2022.2.1 support these two, too.

For assumed-length or deferred-length character array, gfortran 12 supports it. ifort reports ICE, and ifx reports Feature found on this line is not yet supported in ifx . (https://godbolt.org/z/9795MYMv1)

BTW, flang-new supports the above two test cases in execution.

2. I also think the standard is not very clear here. As 18.3.1(1), If the type is character, the length type parameter is interoperable if and only if its value is one. To my understanding, the standard only wants users to use character with length one to be interoperable even if it is assumed-length or deferred-length. As I mentioned before, C string has zero terminator, but Fortran character does not have. It should be unsafe to be interoperable for character with length more than 1. I tried gfortran 12 with -fcheck=bounds, and it did not report runtime errors.

3. All of gfortran 12.2, ifort 2021.7.1 and ifx 2022.2.1 reports semantic errors when the length is constant and more than 1 (violate 18.3.1(1)).

All in all, for BIND(C) procedure character arugment, we may only report semantic error when the length is constant and more than 1. For assumed-length or deferred-length, we can allow it for now. @jeanPerier What do you think?

[jeanPerier]

flang/lib/Semantics/check-declarations.cpp

404

To my understanding, the standard only wants users to use character with length one to be interoperable even if it is assumed-length or deferred-length. As I mentioned before, C string has zero terminator, but Fortran character does not have. It should be unsafe to be interoperable for character with length more than 1.

I am not sure about that because the standard mandates to use a CFI descriptor for assumed-length/deferred length, so the (byte) length of the character is safely accessible from C elem_len descriptor field and user may very well manipulate it using all the n versions of the C library (e.g. strncmp).

By the way, I notice that even though we compile and run "correctly" BIND(C) for scalar assumed length with a Fortran caller and callee, we are not using a CFI descriptor (fir.box) as we should.

All in all, for BIND(C) procedure character arugment, we may only report semantic error when the length is constant and more than 1. For assumed-length or deferred-length, we can allow it for now. @jeanPerier What do you think?

Sounds fine to me. In a very pedantic way, I think we could also allow "assumed-shape, assumed-rank without the CONTIGUOUS" attribute with explicit length since it is covered by the third bullet point in (5) and (6) only applies to pointer/allocatable. The latest gfortran allow this (e.g character(10) :: c2(:)) (but not scalar or explicit shape with explicit length). Adding @klausler in the discussion to validate this.

[peixin]

flang/lib/Semantics/check-declarations.cpp

404

I am not sure about that because the standard mandates to use a CFI descriptor for assumed-length/deferred length, so the (byte) length of the character is safely accessible from C elem_len descriptor field and user may very well manipulate it using all the n versions of the C library (e.g. strncmp).

By the way, I notice that even though we compile and run "correctly" BIND(C) for scalar assumed length with a Fortran caller and callee, we are not using a CFI descriptor (fir.box) as we should.

Right. I missed this part.

The latest gfortran allow this (e.g character(10) :: c2(:)) (but not scalar or explicit shape with explicit length).

Check this example (https://godbolt.org/z/Krdnf3c6d), it seems gfortran uses CFI descriptor for this case. If we can support the explicit length in lowering using CFI decriptor, maybe one portability warning is better instead of following the support in gfortran (gfortran 13 may support more)?

BTW, it seems the standard does not disallow the explicit length (more than 1) character dummy argument without the VALUE attribute explicitly.

[peixin]

Restrict this patch to C1553. Leave BIND(C) argument work (lowering and semantic check) in https://github.com/llvm/llvm-project/issues/59881.

[peixin]

Fix clang-format issue. It seems that ../build/bin/clang-format is not consistent with buildbot clang-format check.

[jeanPerier]

Looks good, thanks for all the rework @peixin

flang/lib/Semantics/check-declarations.cpp

void SayWithDeclaration(const Symbol &symbol, A &&...x) {
     if (parser::Message * msg{messages_.Say(std::forward<A>(x)...)}) {
       if (messages_.at().begin() != symbol.name().begin()) {
         evaluate::AttachDeclaration(*msg, symbol);
       }
     }
   }
   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);
   bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
   void CheckDioDummyIsDerived(const Symbol &, const Symbol &,
       GenericKind::DefinedIo ioKind, const Symbol &);
   void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
   void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
void CheckHelper::Check(const Symbol &symbol) {
   }
   if (symbol.attrs().test(Attr::VALUE)) {
     CheckValue(symbol, derived);
   }
   if (symbol.attrs().test(Attr::CONTIGUOUS) && IsPointer(symbol) &&
       symbol.Rank() == 0) { // C830
     messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);
   }
-  if (IsDummy(symbol)) {
+  bool dummy{IsDummy(symbol)};
+  bool funcRes{IsFunctionResult(symbol)};
+  if (dummy) {
     if (IsNamedConstant(symbol)) {
       messages_.Say(
           "A dummy argument may not also be a named constant"_err_en_US);
     }
     if (!symbol.test(Symbol::Flag::InDataStmt) /*caught elsewhere*/ &&
         IsSaved(symbol)) {
       messages_.Say(
           "A dummy argument may not have the SAVE attribute"_err_en_US);
     }
-  } else if (IsFunctionResult(symbol)) {
+  } else if (funcRes) {
     if (IsNamedConstant(symbol)) {
       messages_.Say(
           "A function result may not also be a named constant"_err_en_US);
     }
     if (!symbol.test(Symbol::Flag::InDataStmt) /*caught elsewhere*/ &&
         IsSaved(symbol)) {
       messages_.Say(
           "A function result may not have the SAVE attribute"_err_en_US);
     }
+    CheckBindCFunctionResult(symbol);
+  }
+  if (dummy || funcRes) {
+    if (innermostSymbol_ && IsBindCProcedure(*innermostSymbol_)) {
+      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) {
+          if (funcRes) {
+            messages_.Say(
+                "BIND(C) function result must have the length type parameter of value 1 if it is character type"_err_en_US);
+          } else {
+            messages_.Say(
+                "BIND(C) procedure argument must have the length type parameter of value 1 if it is character type"_err_en_US);
+          }
+        }
+      }
+    }
   }
   if (symbol.owner().IsDerivedType() &&
       (symbol.attrs().test(Attr::CONTIGUOUS) &&
           !(IsPointer(symbol) && symbol.Rank() > 0))) { // C752
     messages_.Say(
         "A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
   }
   if (symbol.owner().IsModule() && IsAutomatic(symbol)) {
     messages_.Say(
         "Automatic data object '%s' may not appear in the specification part"
         " of a module"_err_en_US,
         symbol.name());
   }
 }
 
 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 (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)) {
     messages_.Say(
         "VALUE attribute may apply only to a dummy argument"_err_en_US);
   }
   if (IsProcedure(symbol)) {
     messages_.Say(

flang/test/Semantics/bind-c09.f90

+! 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(arg) result(res) bind(c)
+  ! ERROR: BIND(C) function result must have the length type parameter of value 1 if it is character type
+  character(*) :: res
+  ! ERROR: BIND(C) procedure argument must have the length type parameter of value 1 if it is character type
+  character(*) :: arg
+end
+
+function func5(n, arg) result(res) bind(c)
+  integer :: n
+  ! ERROR: BIND(C) function result must have the length type parameter of value 1 if it is character type
+  character(n) :: res
+  ! ERROR: BIND(C) procedure argument must have the length type parameter of value 1 if it is character type
+  character(n) :: arg
+end
+
+function func6(arg) result(res) bind(c)
+  ! ERROR: BIND(C) function result must have the length type parameter of value 1 if it is character type
+  character(2) :: res
+  ! ERROR: BIND(C) procedure argument must have the length type parameter of value 1 if it is character type
+  character(2) :: arg
+end
+
+function func7(arg) result(res) bind(c)
+  integer, parameter :: n = 1
+  character(n) :: res, arg! OK
+end
+
+function func8(arg) result(res) bind(c)
+  ! ERROR: BIND(C) function result cannot have ALLOCATABLE or POINTER attribute
+  ! ERROR: BIND(C) function result must have the length type parameter of value 1 if it is character type
+  character(:), pointer :: res
+  ! ERROR: BIND(C) procedure argument must have the length type parameter of value 1 if it is character type
+  character(:), pointer :: arg
+end
+
+function func9() result(res) bind(c)
+  ! ERROR: BIND(C) function result cannot be a coarray
+  integer :: res[10, *]
+end