]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/90093 (Extended C interop: optional argument incorrectly identified...
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 11 May 2019 07:49:52 +0000 (07:49 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 11 May 2019 07:49:52 +0000 (07:49 +0000)
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

gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c [new file with mode: 0644]
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 [new file with mode: 0644]

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 (file)
index 0000000..279d9f6
--- /dev/null
@@ -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 (file)
index 0000000..d71c677
--- /dev/null
@@ -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 (file)
index 0000000..ebf9a24
--- /dev/null
@@ -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