view gcc/testsuite/gfortran.dg/deferred_character_3.f90 @ 128:fe568345ddd5

fix CbC-example
author mir3636
date Wed, 11 Apr 2018 19:32:28 +0900
parents 04ced10e8804
children 84e7813d76e9
line wrap: on
line source

! { dg-do run }
!
! Tests the fix for PR67674
!
! Contributed by Kristopher Kuhlman  <kristopher.kuhlman@gmail.com>
!
program test
  implicit none

  type string_type
    character(len=:), allocatable :: name
  end type string_type
  type(string_type), allocatable :: my_string_type

  allocate(my_string_type)
  allocate(character(len=0) :: my_string_type%name)

!  print *, 'length main program before',len(my_string_type%name)

  call inputreadword1(my_string_type%name)

!  print *, 'length main program after',len(my_string_type%name)
!  print *, 'final result:',my_string_type%name
  if (my_string_type%name .ne. 'here the word is finally set') call abort

contains
  subroutine inputreadword1(word_intermediate)
    character(len=:), allocatable :: word_intermediate

!    print *, 'length intermediate before',len(word_intermediate)
    call inputreadword2(word_intermediate)
!    print *, 'length intermediate after',len(word_intermediate)
!    print *, word_intermediate

  end subroutine inputreadword1

  subroutine inputreadword2(word)
    character(len=:), allocatable :: word

!    print *, 'length inner before',len(word)
    word = 'here the word is finally set' ! want automatic reallocation to happen here
!    print *, 'length inner after',len(word)
!    print *, word

  end subroutine inputreadword2
end program test