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