From: Tobias Burnus Date: Fri, 6 May 2011 18:33:31 +0000 (+0200) Subject: Really commit: X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7b040949f623196f1959b1c21a2b851d835d9970;p=gcc.git Really commit: 2011-05-06 Tobias Burnus 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 index 00000000000..703ab5f19fa --- /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 index 00000000000..ffc90b728b5 --- /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 + +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 (); +}