summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/achar_6.F90
blob: dd93c27472c0ad03ee85dc047be6f12d8b0531fe (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
! { dg-do run }
! { dg-options "-fbackslash" }

#define TEST(x,y,z) \
  call test (x, y, z, iachar(x), iachar(y), ichar(x), ichar(y))

  TEST("a", 4_"a", 97)
  TEST("\0", 4_"\0", 0)
  TEST("\b", 4_"\b", 8)
  TEST("\x80", 4_"\x80", int(z'80'))
  TEST("\xFF", 4_"\xFF", int(z'FF'))

#define TEST2(y,z) \
  call test_bis (y, z, iachar(y), ichar(y))

  TEST2(4_"\u0100", int(z'0100'))
  TEST2(4_"\ufe00", int(z'fe00'))
  TEST2(4_"\u106a", int(z'106a'))
  TEST2(4_"\uff00", int(z'ff00'))
  TEST2(4_"\uffff", int(z'ffff'))

contains

subroutine test (s1, s4, i, i1, i2, i3, i4)
  character(kind=1,len=1) :: s1
  character(kind=4,len=1) :: s4
  integer :: i, i1, i2, i3, i4

  if (i /= i1) call abort
  if (i /= i2) call abort
  if (i /= i3) call abort
  if (i /= i4) call abort

  if (iachar (s1) /= i) call abort
  if (iachar (s4) /= i) call abort
  
  if (ichar (s1) /= i) call abort
  if (ichar (s4) /= i) call abort
  
  if (achar(i, kind=1) /= s1) call abort
  if (achar(i, kind=4) /= s4) call abort

  if (char(i, kind=1) /= s1) call abort
  if (char(i, kind=4) /= s4) call abort

  if (iachar(achar(i, kind=1)) /= i) call abort
  if (iachar(achar(i, kind=4)) /= i) call abort

  if (ichar(char(i, kind=1)) /= i) call abort
  if (ichar(char(i, kind=4)) /= i) call abort

end subroutine test

subroutine test_bis (s4, i, i2, i4)
  character(kind=4,len=1) :: s4
  integer :: i, i2, i4

  if (i /= i2) call abort
  if (i /= i4) call abort

  if (iachar (s4) /= i) call abort
  if (ichar (s4) /= i) call abort
  if (achar(i, kind=4) /= s4) call abort
  if (char(i, kind=4) /= s4) call abort
  if (iachar(achar(i, kind=4)) /= i) call abort
  if (ichar(char(i, kind=4)) /= i) call abort

end subroutine test_bis

end