gcc/testsuite/gfortran.dg/pr85996.f90

   1 ! { dg-do compile }
   2 module strings
   3
   4    type string
   5       integer :: len = 0, size = 0
   6       character, pointer :: chars(:) => null()
   7    end type string
   8
   9    interface length
  10       module procedure len_s
  11    end interface
  12
  13    interface char
  14       module procedure s_to_c, s_to_slc
  15    end interface
  16
  17    interface uppercase
  18       module procedure uppercase_c
  19    end interface
  20
  21    interface replace
  22       module procedure replace_ccs
  23    end interface
  24
  25    contains
  26
  27       elemental function len_s(s)
  28          type(string), intent(in) :: s
  29          integer :: len_s
  30       end function len_s
  31
  32       pure function s_to_c(s)
  33          type(string),intent(in) :: s
  34          character(length(s)) :: s_to_c
  35       end function s_to_c
  36
  37       pure function s_to_slc(s,long)
  38          type(string),intent(in) :: s
  39          integer, intent(in) :: long
  40          character(long) :: s_to_slc
  41       end function s_to_slc
  42
  43       pure function lr_sc_s(s,start,ss) result(l)
  44          type(string), intent(in) :: s
  45          character(*), intent(in) :: ss
  46          integer, intent(in)  :: start
  47          integer :: l
  48       end function lr_sc_s
  49
  50       pure function lr_ccc(s,tgt,ss,action) result(l)
  51          character(*), intent(in) :: s,tgt,ss,action
  52          integer :: l
  53          select case(uppercase(action))
  54          case default
  55          end select
  56       end function lr_ccc
  57
  58       function replace_ccs(s,tgt,ss) result(r)
  59          character(*), intent(in)             :: s,tgt
  60          type(string), intent(in)             :: ss
  61          character(lr_ccc(s,tgt,char(ss),'first'))  :: r
  62       end function replace_ccs
  63
  64       pure function uppercase_c(c)
  65          character(*), intent(in) :: c
  66          character(len(c)) :: uppercase_c
  67       end function uppercase_c
  68
  69 end module strings