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