| ! PR fortran/92482 |
| ! |
| ! Contributed by José Rui Faustino de Sousa |
| ! |
| |
| program strp_p |
| |
| use, intrinsic :: iso_c_binding, only: & |
| c_char |
| |
| implicit none |
| |
| integer, parameter :: l = 3 |
| |
| character(len=l, kind=c_char), target :: str |
| character(len=:, kind=c_char), pointer :: strp_1 |
| character(len=l, kind=c_char), pointer :: strp_2 |
| |
| str = "abc" |
| nullify(strp_1, strp_2) |
| strp_1 => str |
| strp_2 => str |
| if (len(str) /= 3 .or. str /= "abc") stop 1 |
| if (len(strp_1) /= 3 .or. strp_1 /= "abc") stop 2 |
| if (len(strp_2) /= 3 .or. strp_2 /= "abc") stop 3 |
| call strg_print_0("abc") |
| call strg_print_0(str) |
| call strg_print_0(strp_1) |
| call strg_print_0(strp_2) |
| call strg_print_0_c("abc") |
| call strg_print_0_c(str) |
| call strg_print_0_c(strp_1) |
| call strg_print_0_c(strp_2) |
| call strg_print_1(strp_1) |
| call strg_print_1_c(strp_1) |
| |
| call strg_print_2("abc") |
| call strg_print_2(str) |
| call strg_print_2(strp_1) |
| call strg_print_2(strp_2) |
| |
| call strg_print_2_c("abc") |
| call strg_print_2_c(str) |
| call strg_print_2_c(strp_1) |
| call strg_print_2_c(strp_2) |
| |
| contains |
| |
| subroutine strg_print_0 (this) |
| character(len=*, kind=c_char), target, intent(in) :: this |
| |
| if (len (this) /= 3) stop 10 |
| if (this /= "abc") stop 11 |
| end subroutine strg_print_0 |
| |
| subroutine strg_print_0_c (this) bind(c) |
| character(len=*, kind=c_char), target, intent(in) :: this |
| |
| if (len (this) /= 3) stop 10 |
| if (this /= "abc") stop 11 |
| end subroutine strg_print_0_c |
| |
| subroutine strg_print_1 (this) bind(c) |
| character(len=:, kind=c_char), pointer, intent(in) :: this |
| character(len=:), pointer :: strn |
| |
| if (.not. associated (this)) stop 20 |
| if (len (this) /= 3) stop 21 |
| if (this /= "abc") stop 22 |
| strn => this |
| if (.not. associated (strn)) stop 23 |
| if(associated(strn))then |
| if (len (this) /= 3) stop 24 |
| if (this /= "abc") stop 25 |
| end if |
| end subroutine strg_print_1 |
| |
| subroutine strg_print_1_c (this) bind(c) |
| character(len=:, kind=c_char), pointer, intent(in) :: this |
| character(len=:), pointer :: strn |
| |
| if (.not. associated (this)) stop 20 |
| if (len (this) /= 3) stop 21 |
| if (this /= "abc") stop 22 |
| strn => this |
| if (.not. associated (strn)) stop 23 |
| if(associated(strn))then |
| if (len (this) /= 3) stop 24 |
| if (this /= "abc") stop 25 |
| end if |
| end subroutine strg_print_1_c |
| |
| subroutine strg_print_2(this) |
| use, intrinsic :: iso_c_binding, only: & |
| c_loc, c_f_pointer |
| |
| type(*), target, intent(in) :: this(..) |
| character(len=l), pointer :: strn |
| |
| call c_f_pointer(c_loc(this), strn) |
| if (.not. associated (strn)) stop 30 |
| if (associated(strn)) then |
| if (len (strn) /= 3) stop 31 |
| if (strn /= "abc") stop 32 |
| end if |
| end subroutine strg_print_2 |
| |
| subroutine strg_print_2_c(this) bind(c) |
| use, intrinsic :: iso_c_binding, only: & |
| c_loc, c_f_pointer |
| |
| type(*), target, intent(in) :: this(..) |
| character(len=l), pointer :: strn |
| |
| call c_f_pointer(c_loc(this), strn) |
| if (.not. associated (strn)) stop 40 |
| if(associated(strn))then |
| if (len (strn) /= 3) stop 41 |
| if (strn /= "abc") stop 42 |
| end if |
| end subroutine strg_print_2_c |
| |
| end program strp_p |
