gcc/testsuite/gfortran.dg/ichar_1.f90

   1 ! { dg-do compile }
   2 ! PR20879
   3 ! Check that we reject expressions longer than one character for the
   4 ! ICHAR and IACHAR intrinsics.
   5
   6 ! Assumed length variables are special because the frontend doesn't have
   7 ! an expression for their length
   8 subroutine test (c)
   9   character(len=*) :: c
  10   integer i
  11   i = ichar(c)
  12   i = ichar(c(2:))
  13   i = ichar(c(:1))
  14 end subroutine
  15
  16 program ichar_1
  17    type derivedtype
  18       character(len=4) :: addr
  19    end type derivedtype
  20
  21    type derivedtype1
  22       character(len=1) :: addr
  23    end type derivedtype1
  24
  25    integer i
  26    integer, parameter :: j = 2
  27    character(len=8) :: c = 'abcd'
  28    character(len=1) :: g1(2)
  29    character(len=1) :: g2(2,2)
  30    character*1, parameter :: s1 = 'e'
  31    character*2, parameter :: s2 = 'ef'
  32    type(derivedtype) :: dt
  33    type(derivedtype1) :: dt1
  34
  35    if (ichar(c(3:3)) /= 97) call abort
  36    if (ichar(c(:1)) /= 97) call abort
  37    if (ichar(c(j:j)) /= 98) call abort
  38    if (ichar(s1) /= 101) call abort
  39    if (ichar('f') /= 102) call abort
  40    g1(1) = 'a'
  41    if (ichar(g1(1)) /= 97) call abort
  42    if (ichar(g1(1)(:)) /= 97) call abort
  43    g2(1,1) = 'a'
  44    if (ichar(g2(1,1)) /= 97) call abort
  45
  46    i = ichar(c)      ! { dg-error "must be of length one" "" }
  47    i = ichar(c(:))   ! { dg-error "must be of length one" "" }
  48    i = ichar(s2)     ! { dg-error "must be of length one" "" }
  49    i = ichar(c(1:2)) ! { dg-error "must be of length one" "" }
  50    i = ichar(c(1:))  ! { dg-error "must be of length one" "" }
  51    i = ichar('abc')  ! { dg-error "must be of length one" "" }
  52
  53    ! ichar and iachar use the same checking routines. DO a couple of tests to
  54    ! make sure it's not totally broken.
  55
  56    if (ichar(c(3:3)) /= 97) call abort
  57    i = ichar(c)      ! { dg-error "must be of length one" "" }
  58
  59    i = ichar(dt%addr(1:1))
  60    i = ichar(dt%addr) ! { dg-error "must be of length one" "" }
  61    i = ichar(dt%addr(1:2)) ! { dg-error "must be of length one" "" }
  62    i = ichar(dt%addr(1:)) ! { dg-error "must be of length one" "" }
  63
  64    i = ichar(dt1%addr(1:1))
  65    i = ichar(dt1%addr)
  66
  67
  68    call test(g1(1))
  69 end program ichar_1