[gcc/devel/omp/gcc-9] re PR fortran/90093 (Extended C interop: optional argument incorrectly identified as PRESENT)
Tobias Burnus
burnus@gcc.gnu.org
Thu Mar 5 13:47:00 GMT 2020
https://gcc.gnu.org/g:c4de1839668f04ec5d62e1f9cfcf9c1a86febaaa
commit c4de1839668f04ec5d62e1f9cfcf9c1a86febaaa
Author: Paul Thomas <pault@gcc.gnu.org>
Date: Sat May 11 07:49:52 2019 +0000
re PR fortran/90093 (Extended C interop: optional argument incorrectly identified as PRESENT)
2019-05-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/90093
* gfortran.dg/ISO_Fortran_binding_12.f90: New test.
* gfortran.dg/ISO_Fortran_binding_12.c: Supplementary code.
PR fortran/90352
* gfortran.dg/iso_c_binding_char_1.f90: New test.
PR fortran/90355
* gfortran.dg/ISO_Fortran_binding_4.f90: Add 'substr' to test
the direct passing of substrings as descriptors to bind(C).
* gfortran.dg/assign_10.f90: Increase the tree_dump count of
'atmp' to account for the setting of the 'span' field.
* gfortran.dg/transpose_optimization_2.f90: Ditto.
From-SVN: r271090
Diff:
---
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c | 29 ++++++++++++
.../gfortran.dg/ISO_Fortran_binding_12.f90 | 53 ++++++++++++++++++++++
gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 | 10 ++++
3 files changed, 92 insertions(+)
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c
new file mode 100644
index 0000000..279d9f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c
@@ -0,0 +1,29 @@
+/* Test the fix for PR90093. */
+
+#include <stdio.h>
+#include <math.h>
+#include "../../../libgfortran/ISO_Fortran_binding.h"
+
+/* Contributed by Reinhold Bader <Bader@lrz.de> */
+
+void foo_opt(CFI_cdesc_t *, float *, int *, int);
+void write_res();
+
+float x[34];
+
+int main() {
+ CFI_CDESC_T(1) xd;
+ CFI_index_t ext[] = {34};
+ int sz;
+
+ CFI_establish((CFI_cdesc_t *) &xd, &x, CFI_attribute_other,
+ CFI_type_float, 0, 1, ext);
+
+ foo_opt((CFI_cdesc_t *) &xd, NULL, NULL, 0);
+ sz = 12;
+ foo_opt(NULL, &x[11], &sz, 1);
+
+ write_res();
+
+ return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90
new file mode 100644
index 0000000..d71c677
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90
@@ -0,0 +1,53 @@
+! { dg-do run { target c99_runtime } }
+! { dg-additional-sources ISO_Fortran_binding_12.c }
+!
+! Test the fix for PR90093. The additional source is the main program.
+!
+! Contributed by Reinhold Bader <Bader@lrz.de>
+!
+module mod_optional
+ use, intrinsic :: iso_c_binding
+ implicit none
+ integer :: status = 0
+
+contains
+
+ subroutine foo_opt(this, that, sz, flag) bind(c)
+ real(c_float), optional :: this(:)
+ real(c_float), optional :: that(*)
+ integer(c_int), optional :: sz
+ integer(c_int), value :: flag
+ if (flag == 0) then
+ if (.not. present(this) .or. present(that) .or. present(sz)) then
+ write(*,*) 'FAIL 1', present(this), present(that), present(sz)
+ status = status + 1
+ end if
+ else if (flag == 1) then
+ if (present(this) .or. .not. present(that) .or. .not. present(sz)) then
+ write(*,*) 'FAIL 2', present(this), present(that), present(sz)
+ status = status + 1
+ end if
+ if (sz /= 12) then
+ write(*,*) 'FAIL 3'
+ status = status + 1
+ end if
+ else if (flag == 2) then
+ if (present(this) .or. present(that) .or. present(sz)) then
+ write(*,*) 'FAIL 4', present(this), present(that), present(sz)
+ status = status + 1
+ end if
+ end if
+ end subroutine foo_opt
+
+ subroutine write_res() BIND(C)
+! Add a check that the fortran missing optional is accepted by the
+! bind(C) procedure.
+ call foo_opt (flag = 2)
+ if (status == 0) then
+ write(*,*) 'OK'
+ else
+ stop 1
+ end if
+ end subroutine
+
+end module mod_optional
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
new file mode 100644
index 0000000..ebf9a24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! Test the fix for PR90352.
+!
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+subroutine bar(c,d) BIND(C) ! { dg-error "must be length 1" }
+ character (len=*) c
+ character (len=2) d
+end
More information about the Gcc-cvs
mailing list