gcc/testsuite/gfortran.dg/deferred_character_27.f90

   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 !
   8 MODULE 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
  87 END MODULE test