1! { dg-do run }
2! Fix for PR29699 - see below for details.
3!
4! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
5!
6PROGRAM vocabulary_word_count
7
8  IMPLICIT NONE
9  TYPE VARYING_STRING
10    CHARACTER,DIMENSION(:),ALLOCATABLE :: chars
11  ENDTYPE VARYING_STRING
12
13  INTEGER :: list_size=200
14
15  call extend_lists2
16
17CONTAINS
18
19! First the original problem: vocab_swap not being referenced caused
20! an ICE because default initialization is used, which results in a
21! call to gfc_conv_variable, which calls gfc_get_symbol_decl.
22
23  SUBROUTINE extend_lists1
24    type(VARYING_STRING),DIMENSION(list_size) :: vocab_swap
25  ENDSUBROUTINE extend_lists1
26
27! Curing this then uncovered two more problems: If vocab_swap were
28! actually referenced, an ICE occurred in the gimplifier because
29! the declaration for this automatic array is presented as a
30! pointer to the array, rather than the array. Curing this allows
31! the code to compile but it bombed out at run time because the
32! malloc/free occurred in the wrong order with respect to the
33! nullify/deallocate of the allocatable components.
34
35  SUBROUTINE extend_lists2
36    type(VARYING_STRING),DIMENSION(list_size) :: vocab_swap
37    allocate (vocab_swap(1)%chars(10))
38    if (.not.allocated(vocab_swap(1)%chars)) STOP 1
39    if (allocated(vocab_swap(10)%chars)) STOP 2
40  ENDSUBROUTINE extend_lists2
41
42ENDPROGRAM vocabulary_word_count
43