| ! { dg-do run } |
| ! PR fortran/113866 |
| ! |
| ! Check interoperability of assumed-length character (optional and |
| ! non-optional) dummies between bind(c) and non-bind(c) procedures |
| |
| module bindcchar |
| implicit none |
| integer, parameter :: n = 100, l = 10 |
| contains |
| subroutine bindc_optional (c2, c4) bind(c) |
| character(*), optional :: c2, c4(n) |
| ! print *, c2(1:3) |
| ! print *, c4(5)(1:3) |
| if (.not. present (c2) .or. .not. present (c4)) stop 8 |
| if (len (c2) /= l .or. len (c4) /= l) stop 81 |
| if (c2(1:3) /= "a23") stop 1 |
| if (c4(5)(1:3) /= "bcd") stop 2 |
| end |
| |
| subroutine bindc (c2, c4) bind(c) |
| character(*) :: c2, c4(n) |
| if (len (c2) /= l .or. len (c4) /= l) stop 82 |
| if (c2(1:3) /= "a23") stop 3 |
| if (c4(5)(1:3) /= "bcd") stop 4 |
| call bindc_optional (c2, c4) |
| end |
| |
| subroutine not_bindc_optional (c1, c3) |
| character(*), optional :: c1, c3(n) |
| if (.not. present (c1) .or. .not. present (c3)) stop 5 |
| if (len (c1) /= l .or. len (c3) /= l) stop 83 |
| call bindc_optional (c1, c3) |
| call bindc (c1, c3) |
| end |
| |
| subroutine not_bindc_optional_deferred (c5, c6) |
| character(:), allocatable, optional :: c5, c6(:) |
| if (.not. present (c5) .or. .not. present (c6)) stop 6 |
| if (len (c5) /= l .or. len (c6) /= l) stop 84 |
| call not_bindc_optional (c5, c6) |
| call bindc_optional (c5, c6) |
| call bindc (c5, c6) |
| end |
| |
| subroutine not_bindc_optional2 (c7, c8) |
| character(*), optional :: c7, c8(:) |
| if (.not. present (c7) .or. .not. present (c8)) stop 7 |
| if (len (c7) /= l .or. len (c8) /= l) stop 85 |
| call bindc_optional (c7, c8) |
| call bindc (c7, c8) |
| end |
| |
| subroutine bindc_optional2 (c2, c4) bind(c) |
| character(*), optional :: c2, c4(n) |
| if (.not. present (c2) .or. .not. present (c4)) stop 8 |
| if (len (c2) /= l .or. len (c4) /= l) stop 86 |
| if (c2(1:3) /= "a23") stop 9 |
| if (c4(5)(1:3) /= "bcd") stop 10 |
| call bindc_optional (c2, c4) |
| call not_bindc_optional (c2, c4) |
| end |
| |
| subroutine bindc_optional_missing (c1, c2, c3, c4, c5) bind(c) |
| character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*) |
| if (present (c1)) stop 11 |
| if (present (c2)) stop 12 |
| if (present (c3)) stop 13 |
| if (present (c4)) stop 14 |
| if (present (c5)) stop 15 |
| end |
| |
| subroutine non_bindc_optional_missing (c1, c2, c3, c4, c5) |
| character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*) |
| if (present (c1)) stop 21 |
| if (present (c2)) stop 22 |
| if (present (c3)) stop 23 |
| if (present (c4)) stop 24 |
| if (present (c5)) stop 25 |
| end |
| end module |
| |
| program p |
| use bindcchar |
| implicit none |
| character(l) :: a, b(n) |
| character(:), allocatable :: d, e(:) |
| a = 'a234567890' |
| b = 'bcdefghijk' |
| call not_bindc_optional (a, b) |
| call bindc_optional (a, b) |
| call not_bindc_optional2 (a, b) |
| call bindc_optional2 (a, b) |
| allocate (d, source=a) |
| allocate (e, source=b) |
| call not_bindc_optional (d, e) |
| call bindc_optional (d, e) |
| call not_bindc_optional2 (d, e) |
| call bindc_optional2 (d, e) |
| call not_bindc_optional_deferred (d, e) |
| deallocate (d, e) |
| call non_bindc_optional_missing () |
| call bindc_optional_missing () |
| end |
