diff mbox series

Fortran: fix passing of optional dummies to bind(c) procedures [PR113866]

Message ID trinity-5dd087fa-83a3-41dc-8b2a-e3f74c90944c-1707771428331@3c-app-gmx-bap22
State New
Headers show
Series Fortran: fix passing of optional dummies to bind(c) procedures [PR113866] | expand

Commit Message

Harald Anlauf Feb. 12, 2024, 8:57 p.m. UTC 
Dear all,

the attached patch fixes a mis-handling of optional dummy arguments
passed to optional dummy arguments of procedures with the bind(c)
attribute.  When those procedures are expecting CFI descriptors,
there is no special treatment like a presence check necessary
that by default passes a NULL pointer as default.

The testcase tries to exercise various combinations of passing
assumed-length character between bind(c) and non-bind(c), which
apparently was insufficiently covered in the testsuite.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

Comments

Steve Kargl Feb. 13, 2024, 5:21 p.m. UTC | #1 
On Mon, Feb 12, 2024 at 09:57:08PM +0100, Harald Anlauf wrote:
> Dear all,
> 
> the attached patch fixes a mis-handling of optional dummy arguments
> passed to optional dummy arguments of procedures with the bind(c)
> attribute.  When those procedures are expecting CFI descriptors,
> there is no special treatment like a presence check necessary
> that by default passes a NULL pointer as default.
> 
> The testcase tries to exercise various combinations of passing
> assumed-length character between bind(c) and non-bind(c), which
> apparently was insufficiently covered in the testsuite.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 

Yes.  Thanks for filling out the more detailed testcase.
Harald Anlauf Feb. 13, 2024, 6:13 p.m. UTC | #2 
Hi Steve,

Am 13.02.24 um 18:21 schrieb Steve Kargl:
> On Mon, Feb 12, 2024 at 09:57:08PM +0100, Harald Anlauf wrote:
>> Dear all,
>>
>> the attached patch fixes a mis-handling of optional dummy arguments
>> passed to optional dummy arguments of procedures with the bind(c)
>> attribute.  When those procedures are expecting CFI descriptors,
>> there is no special treatment like a presence check necessary
>> that by default passes a NULL pointer as default.
>>
>> The testcase tries to exercise various combinations of passing
>> assumed-length character between bind(c) and non-bind(c), which
>> apparently was insufficiently covered in the testsuite.
>>
>> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>>
> 
> Yes.  Thanks for filling out the more detailed testcase.

indeed the new testcase just regressed due to commit
r14-8947-g6caec7d9ec37e6 ... :-(

Reduced testcase which fails on trunk:

program p
   implicit none
   integer, parameter :: n = 100, l = 10
   character(l) :: a = 'a234567890', b(n) = 'bcdefghijk'
   character(:), allocatable :: d, e(:)
   allocate (d, source=a)
   allocate (e, source=b)
   print *, len (d), len (e), size (e)
   call not_bindc_optional_deferred (d, e)
   deallocate (d, e)
contains
   subroutine not_bindc_optional_deferred (c5, c6)
     character(:), allocatable, optional :: c5, c6(:)
     if (.not. present (c5) .or. .not. present (c6)) stop 6
     print *, len (c5), len (c6), size (c6)
     if (len (c5) /= l .or. len (c6) /= l) stop 84
   end
end

Expected:

           10          10         100
           10          10         100

After above commit:

           10          10         100
           10           0         100
STOP 84

Will have to wait until the cause is found and fixed...
Harald Anlauf Feb. 13, 2024, 7:28 p.m. UTC | #3 
Am 13.02.24 um 19:13 schrieb Harald Anlauf:
> indeed the new testcase just regressed due to commit
> r14-8947-g6caec7d9ec37e6 ... :-(
>
> Reduced testcase which fails on trunk:
>
> program p
>    implicit none
>    integer, parameter :: n = 100, l = 10
>    character(l) :: a = 'a234567890', b(n) = 'bcdefghijk'
>    character(:), allocatable :: d, e(:)
>    allocate (d, source=a)
>    allocate (e, source=b)
>    print *, len (d), len (e), size (e)
>    call not_bindc_optional_deferred (d, e)
>    deallocate (d, e)
> contains
>    subroutine not_bindc_optional_deferred (c5, c6)
>      character(:), allocatable, optional :: c5, c6(:)
>      if (.not. present (c5) .or. .not. present (c6)) stop 6
>      print *, len (c5), len (c6), size (c6)
>      if (len (c5) /= l .or. len (c6) /= l) stop 84
>    end
> end
>
> Expected:
>
>            10          10         100
>            10          10         100
>
> After above commit:
>
>            10          10         100
>            10           0         100
> STOP 84

This is now tracked as::

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=113911

> Will have to wait until the cause is found and fixed...

As it is sufficient to disable the deferred-length test,
I've done that and pushed the amended patch as

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

Thanks,
Harald
diff mbox series

Patch

From 87d1b973a4d6a561dc3f3a0c4c10f76d155fa000 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 12 Feb 2024 21:39:09 +0100
Subject: [PATCH] Fortran: fix passing of optional dummies to bind(c)
 procedures [PR113866]

	PR fortran/113866

gcc/fortran/ChangeLog:

	* trans-expr.cc (gfc_conv_procedure_call): When passing an optional
	dummy argument to an optional dummy argument of a bind(c) procedure
	and the dummy argument is passed via a CFI descriptor, no special
	presence check and passing of a default NULL pointer is needed.

gcc/testsuite/ChangeLog:

	* gfortran.dg/bind_c_optional-2.f90: New test.
---
 gcc/fortran/trans-expr.cc                     |   6 +-
 .../gfortran.dg/bind_c_optional-2.f90         | 104 ++++++++++++++++++
 2 files changed, 108 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/bind_c_optional-2.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 67abca9f6ba..a0593b76f18 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7269,8 +7269,10 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	 with an interface indicating an optional argument.  When we call
 	 an intrinsic subroutine, however, fsym is NULL, but we might still
 	 have an optional argument, so we proceed to the substitution
-	 just in case.  */
-      if (e && (fsym == NULL || fsym->attr.optional))
+	 just in case.  Arguments passed to bind(c) procedures via CFI
+	 descriptors are handled elsewhere.  */
+      if (e && (fsym == NULL || fsym->attr.optional)
+	  && !(sym->attr.is_bind_c && is_CFI_desc (fsym, NULL)))
 	{
 	  /* If an optional argument is itself an optional dummy argument,
 	     check its presence and substitute a null if absent.  This is
diff --git a/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90
new file mode 100644
index 00000000000..b8b4c87775e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90
@@ -0,0 +1,104 @@ 
+! { dg-do run }
+! PR fortran/113866
+!
+! Check interoperability of assumed-length character (optional and
+! non-optional) dummies between bind(c) and non-bind(c) procedures
+
+module bindcchar
+  implicit none
+  integer, parameter :: n = 100, l = 10
+contains
+  subroutine bindc_optional (c2, c4) bind(c)
+    character(*), optional :: c2, c4(n)
+!   print *, c2(1:3)
+!   print *, c4(5)(1:3)
+    if (.not. present (c2) .or. .not. present (c4)) stop 8
+    if (c2(1:3)    /= "a23") stop 1
+    if (c4(5)(1:3) /= "bcd") stop 2
+    if (len (c2) /= l .or. len (c4) /= l) stop 81
+  end
+
+  subroutine bindc (c2, c4) bind(c)
+    character(*) :: c2, c4(n)
+    if (c2(1:3)    /= "a23") stop 3
+    if (c4(5)(1:3) /= "bcd") stop 4
+    if (len (c2) /= l .or. len (c4) /= l) stop 82
+    call bindc_optional (c2, c4)
+  end
+
+  subroutine not_bindc_optional (c1, c3)
+    character(*), optional :: c1, c3(n)
+    if (.not. present (c1) .or. .not. present (c3)) stop 5
+    call bindc_optional (c1, c3)
+    call bindc          (c1, c3)
+    if (len (c1) /= l .or. len (c3) /= l) stop 83
+  end
+
+  subroutine not_bindc_optional_deferred (c5, c6)
+    character(:), allocatable, optional :: c5, c6(:)
+    if (.not. present (c5) .or. .not. present (c6)) stop 6
+    call not_bindc_optional (c5, c6)
+    call bindc_optional     (c5, c6)
+    call bindc              (c5, c6)
+    if (len (c5) /= l .or. len (c6) /= l) stop 84
+  end
+
+  subroutine not_bindc_optional2 (c7, c8)
+    character(*), optional :: c7, c8(:)
+    if (.not. present (c7) .or. .not. present (c8)) stop 7
+    call bindc_optional (c7, c8)
+    call bindc          (c7, c8)
+    if (len (c7) /= l .or. len (c8) /= l) stop 85
+  end
+
+  subroutine bindc_optional2 (c2, c4) bind(c)
+    character(*), optional :: c2, c4(n)
+    if (.not. present (c2) .or. .not. present (c4)) stop 8
+    if (c2(1:3)    /= "a23") stop 9
+    if (c4(5)(1:3) /= "bcd") stop 10
+    call bindc_optional     (c2, c4)
+    call not_bindc_optional (c2, c4)
+    if (len (c2) /= l .or. len (c4) /= l) stop 86
+  end
+
+  subroutine bindc_optional_missing (c1, c2, c3, c4, c5) bind(c)
+    character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*)
+    if (present (c1)) stop 11
+    if (present (c2)) stop 12
+    if (present (c3)) stop 13
+    if (present (c4)) stop 14
+    if (present (c5)) stop 15
+  end
+
+  subroutine non_bindc_optional_missing (c1, c2, c3, c4, c5)
+    character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*)
+    if (present (c1)) stop 21
+    if (present (c2)) stop 22
+    if (present (c3)) stop 23
+    if (present (c4)) stop 24
+    if (present (c5)) stop 25
+  end
+end module
+
+program p
+  use bindcchar
+  implicit none
+  character(l) :: a, b(n)
+  character(:), allocatable :: d, e(:)
+  a = 'a234567890'
+  b = 'bcdefghijk'
+  call not_bindc_optional (a, b)
+  call bindc_optional (a, b)
+  call not_bindc_optional2 (a, b)
+  call bindc_optional2 (a, b)
+  allocate (d, source=a)
+  allocate (e, source=b)
+  call not_bindc_optional (d, e)
+  call bindc_optional (d, e)
+  call not_bindc_optional2 (d, e)
+  call not_bindc_optional_deferred (d, e)
+  call bindc_optional2 (d, e)
+  deallocate (d, e)
+  call non_bindc_optional_missing ()
+  call bindc_optional_missing ()
+end
--
2.35.3