gcc/testsuite/gfortran.dg/bind-c-char-descr.f90

   1 ! PR fortran/92482
   2 !
   3 ! Contributed by José Rui Faustino de Sousa
   4 !
   5
   6 program strp_p
   7
   8   use, intrinsic :: iso_c_binding, only: &
   9     c_char
  10
  11   implicit none
  12
  13   integer, parameter :: l = 3
  14
  15   character(len=l, kind=c_char),  target :: str
  16   character(len=:, kind=c_char), pointer :: strp_1
  17   character(len=l, kind=c_char), pointer :: strp_2
  18
  19   str = "abc"
  20   nullify(strp_1, strp_2)
  21   strp_1 => str
  22   strp_2 => str
  23   if (len(str) /= 3 .or. str /= "abc") stop 1
  24   if (len(strp_1) /= 3 .or. strp_1 /= "abc") stop 2
  25   if (len(strp_2) /= 3 .or. strp_2 /= "abc") stop 3
  26   call strg_print_0("abc")
  27   call strg_print_0(str)
  28   call strg_print_0(strp_1)
  29   call strg_print_0(strp_2)
  30   call strg_print_0_c("abc")
  31   call strg_print_0_c(str)
  32   call strg_print_0_c(strp_1)
  33   call strg_print_0_c(strp_2)
  34   call strg_print_1(strp_1)
  35   call strg_print_1_c(strp_1)
  36
  37   call strg_print_2("abc")
  38   call strg_print_2(str)
  39   call strg_print_2(strp_1)
  40   call strg_print_2(strp_2)
  41
  42   call strg_print_2_c("abc")
  43   call strg_print_2_c(str)
  44   call strg_print_2_c(strp_1)
  45   call strg_print_2_c(strp_2)
  46
  47 contains
  48
  49   subroutine strg_print_0 (this)
  50     character(len=*, kind=c_char), target, intent(in) :: this
  51
  52     if (len (this) /= 3) stop 10
  53     if (this /= "abc") stop 11
  54   end subroutine strg_print_0
  55
  56   subroutine strg_print_0_c (this) bind(c)
  57     character(len=*, kind=c_char), target, intent(in) :: this
  58
  59     if (len (this) /= 3) stop 10
  60     if (this /= "abc") stop 11
  61   end subroutine strg_print_0_c
  62
  63   subroutine strg_print_1 (this) bind(c)
  64     character(len=:, kind=c_char), pointer, intent(in) :: this
  65     character(len=:), pointer :: strn
  66
  67     if (.not. associated (this)) stop 20
  68     if (len (this) /= 3) stop 21
  69     if (this /= "abc") stop 22
  70      strn => this
  71      if (.not. associated (strn)) stop 23
  72      if(associated(strn))then
  73        if (len (this) /= 3) stop 24
  74        if (this /= "abc") stop 25
  75      end if
  76    end subroutine strg_print_1
  77
  78   subroutine strg_print_1_c (this) bind(c)
  79     character(len=:, kind=c_char), pointer, intent(in) :: this
  80     character(len=:), pointer :: strn
  81
  82     if (.not. associated (this)) stop 20
  83     if (len (this) /= 3) stop 21
  84     if (this /= "abc") stop 22
  85      strn => this
  86      if (.not. associated (strn)) stop 23
  87      if(associated(strn))then
  88        if (len (this) /= 3) stop 24
  89        if (this /= "abc") stop 25
  90      end if
  91    end subroutine strg_print_1_c
  92
  93   subroutine strg_print_2(this)
  94     use, intrinsic :: iso_c_binding, only: &
  95       c_loc, c_f_pointer
  96
  97     type(*), target, intent(in) :: this(..)
  98     character(len=l), pointer :: strn
  99
 100     call c_f_pointer(c_loc(this), strn)
 101     if (.not. associated (strn)) stop 30
 102     if (associated(strn)) then
 103       if (len (strn) /= 3) stop 31
 104       if (strn /= "abc") stop 32
 105     end if
 106   end subroutine strg_print_2
 107
 108   subroutine strg_print_2_c(this) bind(c)
 109     use, intrinsic :: iso_c_binding, only: &
 110       c_loc, c_f_pointer
 111
 112     type(*), target, intent(in) :: this(..)
 113     character(len=l), pointer :: strn
 114
 115     call c_f_pointer(c_loc(this), strn)
 116     if (.not. associated (strn)) stop 40
 117     if(associated(strn))then
 118       if (len (strn) /= 3) stop 41
 119       if (strn /= "abc") stop 42
 120     end if
 121   end subroutine strg_print_2_c
 122
 123 end program strp_p