gcc/testsuite/gfortran.dg/deferred_character_6.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests that PR66408 stays fixed.
   4 !
   5 ! Contributed by <werner.blokbuster@gmail.com>
   6 !
   7 module mytest
   8
   9     implicit none
  10
  11     type vary
  12         character(:), allocatable :: string
  13     end type vary
  14
  15     interface assignment(=)
  16         module procedure char_eq_vary
  17     end interface assignment(=)
  18
  19 contains
  20
  21     subroutine char_eq_vary(my_char,my_vary)
  22         character(:), allocatable, intent(out) :: my_char
  23         type(vary), intent(in) :: my_vary
  24         my_char = my_vary%string
  25     end subroutine char_eq_vary
  26
  27 end module mytest
  28
  29
  30 program thistest
  31
  32     use mytest, only: vary, assignment(=)
  33     implicit none
  34
  35     character(:), allocatable :: test_char
  36     character(14), parameter :: str = 'example string'
  37     type(vary) :: test_vary
  38     type(vary) :: my_stuff
  39
  40
  41     test_vary%string = str
  42     if (test_vary%string .ne. str) call abort
  43
  44 ! This previously gave a blank string.
  45     my_stuff%string = test_vary
  46     if (my_stuff%string .ne. str) call abort
  47
  48     test_char = test_vary
  49     if (test_char .ne. str) call abort
  50
  51     my_stuff = test_vary
  52     if (my_stuff%string .ne. str) call abort
  53
  54 end program thistest