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!
9module 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
21contains
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
41end 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
60end
61