[gcc r13-6341] Fortran: Skip bound conv in gfc_conv_gfc_desc_to_cfi_desc with intent(out) ptr [PR108621]

[gcc r13-6341] Fortran: Skip bound conv in gfc_conv_gfc_desc_to_cfi_desc with intent(out) ptr [PR108621]

[Tobias Burnus]

https://gcc.gnu.org/g:d3e427f684b0cd7cedbe7b93a06f455e562c5901

commit r13-6341-gd3e427f684b0cd7cedbe7b93a06f455e562c5901
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Sat Feb 25 11:55:08 2023 +0100

    Fortran: Skip bound conv in gfc_conv_gfc_desc_to_cfi_desc with intent(out) ptr [PR108621]
    
    When the dummy argument of the bind(C) proc is 'pointer, intent(out)', the conversion
    of the GFC to the CFI bounds can be skipped: it is not needed and avoids issues with
    noninit memory.
    
    Note that the 'cfi->base_addr = gfc->addr' assignment is kept as the C code of a user
    might assume that a nullified pointer arrives as NULL (or even a specific value).
    For instance, gfortran.dg/c-interop/section-{1,2}.f90 assumes the value NULL.
    
    Note 2: The PR is about a may-be-uninitialized warning with intent(out). In the PR's
    testcase, the pointer was nullified and should not have produced that warning.
    That is a diagnostic issue, now tracked as PR middle-end/108906 as the issue in principle
    still exists (e.g. with 'intent(inout)'). [But no longer for intent(out).]
    
    Note 3: With undefined pointers and no 'intent', accessing uninit memory is unavoidable
    on the caller side as the compiler cannot know what the C function does (but this usage
    determines whether the pointer is permitted be undefined or whether the bounds must be
    gfc-to-cfi converted).
    
    gcc/fortran/ChangeLog:
    
            PR fortran/108621
            * trans-expr.cc (gfc_conv_gfc_desc_to_cfi_desc): Skip setting of
            bounds of CFI desc for 'pointer,intent(out)'.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/108621
            * gfortran.dg/c-interop/fc-descriptor-pr108621.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc                          |  6 ++
 .../c-interop/fc-descriptor-pr108621.f90           | 65 ++++++++++++++++++++++
 2 files changed, 71 insertions(+)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e85b53fae85..045c8b00b90 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5673,6 +5673,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   gfc_add_modify (&block, tmp,
 		  build_int_cst (TREE_TYPE (tmp), attr));
 
+  /* The cfi-base_addr assignment could be skipped for 'pointer, intent(out)'.
+     That is very sensible for undefined pointers, but the C code might assume
+     that the pointer retains the value, in particular, if it was NULL.  */
   if (e->rank == 0)
     {
       tmp = gfc_get_cfi_desc_base_addr (cfi);
@@ -5695,6 +5698,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
       gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
     }
 
+  if (fsym->attr.pointer && fsym->attr.intent == INTENT_OUT)
+    goto done;
+
   /* When allocatable + intent out, free the cfi descriptor.  */
   if (fsym->attr.allocatable && fsym->attr.intent == INTENT_OUT)
     {
diff --git a/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-pr108621.f90 b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-pr108621.f90
new file mode 100644
index 00000000000..9c9062bd62d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c-interop/fc-descriptor-pr108621.f90
@@ -0,0 +1,65 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/108621
+!
+! If the bind(C) procedure's dummy argument is a POINTER with INTENT(OUT),
+! avoid converting the array bounds for the CFI descriptor before the call.
+!
+! Rational: Fewer code and, esp. for undefined pointers, there might be a
+! compile-time warning or a runtime error due to the 'extent' arithmentic
+! and integer overflows (i.e. random values and -fsanitize=undefined).
+!
+! (For disassociated pointers, it would/should be only pointless code as
+! the bound setting is guarded by a != NULL condtion. However, as the PR shows,
+! a bogus may-use-uninitialized-memory warning might still be shown in that case.)
+!
+! Without 'intent' (but still intent(out) internally), the same applies but
+! there is nothing the compiler can do on the caller side.
+! Still, as only uninit memory and not invalid memory it accessed, it should still
+! work (at least when run-time checking is turned off).
+!
+subroutine demo(f)
+use, intrinsic :: iso_c_binding, only : c_int
+implicit none
+
+interface
+  subroutine fun(f_p) bind(c)
+    import c_int
+    integer(c_int), pointer, intent(out) :: f_p(:)
+  end subroutine
+end interface
+
+integer(c_int), pointer :: f(:)
+
+call fun(f)
+end
+
+! The following ones must be present even with intent(out):
+!
+! { dg-final { scan-tree-dump "cfi...version = 1;" "original" } }
+! { dg-final { scan-tree-dump "cfi...rank = 1;" "original" } }
+! { dg-final { scan-tree-dump "cfi...type = 1025;" "original" } }
+! { dg-final { scan-tree-dump "cfi...attribute = 0;" "original" } }
+! { dg-final { scan-tree-dump "cfi...elem_len = 4;" "original" } }
+
+
+! The following is not needed - but user code might expect that an incoming pointer is NULL
+! in this case. - At least the GCC testsuite expects this in the C code at
+!   gfortran.dg/c-interop/section-{1,2}.f90 
+! Thus, it is kept as it does not cause any harm:
+!
+! { dg-final { scan-tree-dump "cfi...base_addr = f->data;" "original" } }
+
+
+! The following ones are not need with intent(out) and, therefore, shouldn't be there:
+!
+!     cfi.0.dim[idx.1].lower_bound = f->dim[idx.1].lbound;
+!     cfi.0.dim[idx.1].extent = (f->dim[idx.1].ubound - f->dim[idx.1].lbound) + 1;
+!     cfi.0.dim[idx.1].sm = f->dim[idx.1].stride * f->span;
+!
+! Now match those - but using a rather generic pattern as it is a ...-not scan:
+!
+! { dg-final { scan-tree-dump-not "lower_bound = " "original" } }
+! { dg-final { scan-tree-dump-not "extent = " "original" } }
+! { dg-final { scan-tree-dump-not "sm = " "original" } }