Really commit:

2011-05-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48858
        PR fortran/48820
        * gfortran.dg/bind_c_usage_24.f90: New.
        * gfortran.dg/bind_c_usage_24_c.c: New.

From-SVN: r173503

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_24.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_24.f90
new file mode 100644 (file)
index 0000000..703ab5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_24.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_usage_24_c.c }
+!
+! PR fortran/48858
+! PR fortran/48820
+!
+! TR 29113: BIND(C) with OPTIONAL
+!
+module m
+  use iso_c_binding
+  interface
+    subroutine c_proc (is_present, var) bind(C)
+      import
+      logical(c_bool), value    :: is_present
+      integer(c_int),  optional :: var
+    end subroutine
+  end interface
+contains
+  subroutine subtest (is_present, var) bind(C)
+    logical(c_bool), intent(in),    value    :: is_present
+    integer(c_int),  intent(inout), optional :: var
+    if (is_present) then
+      if (.not. present (var)) call abort ()
+      if (var /= 43) call abort ()
+      var = -45
+    else
+      if (present (var)) call abort ()
+    end if
+  end subroutine subtest
+end module m
+
+program test
+  use m
+  implicit none
+  integer :: val
+
+  val = 4
+  call c_proc (.false._c_bool)
+  call c_proc (.true._c_bool, val)
+  if (val /= 7) call abort ()
+end program test
+
+! { dg-final { cleanup-modules "m" } }

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_24_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_24_c.c
new file mode 100644 (file)
index 0000000..ffc90b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_24_c.c
@@ -0,0 +1,24 @@
+/* Compiled and linked by bind_c.f90.  */
+
+#include <stdlib.h>
+
+void subtest (_Bool, int *);
+
+void
+c_proc (_Bool present, int *val)
+{
+  int val2;
+  if (!present && val)
+    abort ();
+  else if (present)
+    {
+      if (!val) abort ();
+      if (*val != 4) abort ();
+      *val = 7;
+    }
+
+  val2 = 43;
+  subtest (1, &val2);
+  subtest (0, NULL);
+  if (val2 != -45) abort ();
+}