gcc/testsuite/gfortran.dg/deferred_character_28.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR80931, which was nearly fix by the patch for PR87151.
   4 ! However, the 'span' for 'temp' was not being set and so a segfault
   5 ! occurred in the assignment at line 39.
   6 !
   7 ! Contributed by Tiziano Mueller  <dev-zero@gentoo.org>
   8 !
   9 module input_section_types
  10    type :: section
  11       character(len=:), allocatable :: keywords_(:)
  12
  13       contains
  14          procedure, pass :: add_keyword
  15    end type
  16
  17    interface section
  18       procedure constructor
  19    end interface
  20
  21 contains
  22
  23    type(section) function constructor ()
  24       allocate (character(len=255) :: constructor%keywords_(0))
  25    end function
  26
  27    subroutine add_keyword (this, name)
  28       class(section), intent(inout) :: this
  29       character(*), intent(in)      :: name
  30       character(len=:), allocatable :: temp(:)
  31
  32       integer :: n_elements
  33
  34       n_elements = size (this%keywords_)
  35       allocate (character(len=255) :: temp(n_elements+1))
  36       temp(:n_elements) = this%keywords_
  37       call move_alloc (temp, this%keywords_)
  38
  39       this%keywords_(n_elements+1) = name
  40    end subroutine
  41 end module
  42
  43    use input_section_types
  44    type(section) :: s
  45    character(*), parameter :: hello = "Hello World"
  46    character(*), parameter :: bye = "Goodbye World"
  47
  48    s = constructor ()
  49
  50    call s%add_keyword (hello)
  51    if (len (s%keywords_) .ne. 255) stop 1
  52    if (size (s%keywords_, 1) .ne. 1) stop 2
  53    if (trim (s%keywords_(1)) .ne. hello) stop 3
  54
  55    call s%add_keyword (bye)
  56    if (len (s%keywords_) .ne. 255) stop 4
  57    if (size (s%keywords_, 1) .ne. 2) stop 5
  58    if (trim (s%keywords_(1)) .ne. hello) stop 6
  59    if (trim (s%keywords_(2)) .ne. bye) stop 7
  60 end