Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 ! { dg-do compile } | |
| 2 program main | |
| 3 use iso_c_binding | |
| 4 interface | |
| 5 subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! Doubtful use ... | |
| 6 import :: c_ptr, c_int, c_double | |
| 7 type(c_ptr), value :: f | |
| 8 integer(c_int), value :: a1, a3 | |
| 9 real(c_double), value :: a2, a4 | |
| 10 end subroutine p1 | |
| 11 | |
| 12 subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! ... with incompatible interfaces | |
| 13 import :: c_ptr, c_int, c_double | |
| 14 type(c_ptr), value :: f | |
| 15 real(c_double), value :: a1, a3 | |
| 16 integer(c_int), value :: a2, a4 | |
| 17 end subroutine p2 | |
| 18 end interface | |
| 19 | |
| 20 type(c_ptr) :: f_ptr | |
| 21 character(len=20), target :: format | |
| 22 | |
| 23 f_ptr = c_loc(format(1:1)) | |
| 24 | |
| 25 format = 'Hello %d %f %d %f\n' // char(0) | |
| 26 call p1(f_ptr, 10, 1.23d0, 20, 2.46d0) | |
| 27 | |
| 28 format = 'World %f %d %f %d\n' // char(0) | |
| 29 call p2(f_ptr, 1.23d0, 10, 2.46d0, 20) | |
| 30 end program main |