1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4! PR fortran/37626
5! Contributed by Rich Townsend
6!
7! The problem was an ICE when trying to deallocate the
8! result variable "x_unique".
9!
10function unique_A (x, sorted) result (x_unique)
11  implicit none
12  character(*), dimension(:), intent(in)       :: x
13  logical, intent(in), optional                :: sorted
14  character(LEN(x)), dimension(:), allocatable :: x_unique
15
16  logical                                      :: sorted_
17  character(LEN(x)), dimension(SIZE(x))        :: x_sorted
18  integer                                      :: n_x
19  logical, dimension(SIZE(x))                  :: mask
20
21  integer, external                            :: b3ss_index
22
23! Set up sorted_
24
25  if(PRESENT(sorted)) then
26     sorted_ = sorted
27  else
28     sorted_ = .FALSE.
29  endif
30
31! If necessary, sort x
32
33  if(sorted_) then
34     x_sorted = x
35  else
36     x_sorted = x(b3ss_index(x))
37  endif
38
39! Set up the unique array
40
41  n_x = SIZE(x)
42
43  mask = (/.TRUE.,x_sorted(2:n_x) /= x_sorted(1:n_x-1)/)
44
45  allocate(x_unique(COUNT(mask)))
46
47  x_unique = PACK(x_sorted, MASK=mask)
48
49! Finish
50
51  return
52end function unique_A
53
54! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
55! { dg-final { cleanup-tree-dump "original" } }
56
57