1! { dg-do compile }
2!
3! Make sure that PR82617 remains fixed. The first attempt at a
4! fix for PR70752 cause this to ICE at the point indicated below.
5!
6! Contributed by Ogmundur Petersson  <uberprugelknabe@hotmail.com>
7!
8MODULE test
9
10  IMPLICIT NONE
11
12  PRIVATE
13  PUBLIC str_words
14
15  !> Characters that are considered whitespace.
16  CHARACTER(len=*), PARAMETER :: strwhitespace = &
17    char(32)//& ! space
18    char(10)//& ! new line
19    char(13)//& ! carriage return
20    char( 9)//& ! horizontal tab
21    char(11)//& ! vertical tab
22    char(12)    ! form feed (new page)
23
24  CONTAINS
25
26  ! -------------------------------------------------------------------
27  !> Split string into words separated by arbitrary strings of whitespace
28  !> characters (space, tab, newline, return, formfeed).
29  FUNCTION str_words(str,white) RESULT(items)
30    CHARACTER(len=:), DIMENSION(:), ALLOCATABLE :: items
31    CHARACTER(len=*), INTENT(in) :: str !< String to split.
32    CHARACTER(len=*), INTENT(in) :: white ! Whitespace characters.
33
34    items = strwords_impl(str,white)
35
36  END FUNCTION str_words
37
38  ! -------------------------------------------------------------------
39  !>Implementation of str_words
40  !> characters (space, tab, newline, return, formfeed).
41  FUNCTION strwords_impl(str,white) RESULT(items)
42    CHARACTER(len=:), DIMENSION(:), ALLOCATABLE :: items
43    CHARACTER(len=*), INTENT(in) :: str !< String to split.
44    CHARACTER(len=*), INTENT(in) :: white ! Whitespace characters.
45
46    INTEGER :: i0,i1,n
47    INTEGER :: l_item,i_item,n_item
48
49    n = verify(str,white,.TRUE.)
50    IF (n>0) THEN
51      n_item = 0
52      l_item = 0
53      i1 = 0
54      DO
55        i0 = verify(str(i1+1:n),white)+i1
56        i1 = scan(str(i0+1:n),white)
57        n_item = n_item+1
58        IF (i1>0) THEN
59          l_item = max(l_item,i1)
60          i1 = i0+i1
61        ELSE
62          l_item = max(l_item,n-i0+1)
63          EXIT
64        END IF
65      END DO
66      ALLOCATE(CHARACTER(len=l_item)::items(n_item))
67      i_item = 0
68      i1 = 0
69      DO
70        i0 = verify(str(i1+1:n),white)+i1
71        i1 = scan(str(i0+1:n),white)
72        i_item = i_item+1
73        IF (i1>0) THEN
74          i1 = i0+i1
75          items(i_item) = str(i0:i1-1)
76        ELSE
77          items(i_item) = str(i0:n)
78          EXIT
79        END IF
80      END DO
81    ELSE
82      ALLOCATE(CHARACTER(len=0)::items(0))
83    END IF
84
85  END FUNCTION strwords_impl
86
87END MODULE test
88