gcc/testsuite/gfortran.dg/deferred_character_3.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests the fix for PR67674
   4 !
   5 ! Contributed by Kristopher Kuhlman  <kristopher.kuhlman@gmail.com>
   6 !
   7 program test
   8   implicit none
   9
  10   type string_type
  11     character(len=:), allocatable :: name
  12   end type string_type
  13   type(string_type), allocatable :: my_string_type
  14
  15   allocate(my_string_type)
  16   allocate(character(len=0) :: my_string_type%name)
  17
  18 !  print *, 'length main program before',len(my_string_type%name)
  19
  20   call inputreadword1(my_string_type%name)
  21
  22 !  print *, 'length main program after',len(my_string_type%name)
  23 !  print *, 'final result:',my_string_type%name
  24   if (my_string_type%name .ne. 'here the word is finally set') STOP 1
  25
  26 contains
  27   subroutine inputreadword1(word_intermediate)
  28     character(len=:), allocatable :: word_intermediate
  29
  30 !    print *, 'length intermediate before',len(word_intermediate)
  31     call inputreadword2(word_intermediate)
  32 !    print *, 'length intermediate after',len(word_intermediate)
  33 !    print *, word_intermediate
  34
  35   end subroutine inputreadword1
  36
  37   subroutine inputreadword2(word)
  38     character(len=:), allocatable :: word
  39
  40 !    print *, 'length inner before',len(word)
  41     word = 'here the word is finally set' ! want automatic reallocation to happen here
  42 !    print *, 'length inner after',len(word)
  43 !    print *, word
  44
  45   end subroutine inputreadword2
  46 end program test