OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [achar_6.F90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-options "-fbackslash" }
3
 
4
#define TEST(x,y,z) \
5
  call test (x, y, z, iachar(x), iachar(y), ichar(x), ichar(y))
6
 
7
  TEST("a", 4_"a", 97)
8
  TEST("\0", 4_"\0", 0)
9
  TEST("\b", 4_"\b", 8)
10
  TEST("\x80", 4_"\x80", int(z'80'))
11
  TEST("\xFF", 4_"\xFF", int(z'FF'))
12
 
13
#define TEST2(y,z) \
14
  call test_bis (y, z, iachar(y), ichar(y))
15
 
16
  TEST2(4_"\u0100", int(z'0100'))
17
  TEST2(4_"\ufe00", int(z'fe00'))
18
  TEST2(4_"\u106a", int(z'106a'))
19
  TEST2(4_"\uff00", int(z'ff00'))
20
  TEST2(4_"\uffff", int(z'ffff'))
21
 
22
contains
23
 
24
subroutine test (s1, s4, i, i1, i2, i3, i4)
25
  character(kind=1,len=1) :: s1
26
  character(kind=4,len=1) :: s4
27
  integer :: i, i1, i2, i3, i4
28
 
29
  if (i /= i1) call abort
30
  if (i /= i2) call abort
31
  if (i /= i3) call abort
32
  if (i /= i4) call abort
33
 
34
  if (iachar (s1) /= i) call abort
35
  if (iachar (s4) /= i) call abort
36
 
37
  if (ichar (s1) /= i) call abort
38
  if (ichar (s4) /= i) call abort
39
 
40
  if (achar(i, kind=1) /= s1) call abort
41
  if (achar(i, kind=4) /= s4) call abort
42
 
43
  if (char(i, kind=1) /= s1) call abort
44
  if (char(i, kind=4) /= s4) call abort
45
 
46
  if (iachar(achar(i, kind=1)) /= i) call abort
47
  if (iachar(achar(i, kind=4)) /= i) call abort
48
 
49
  if (ichar(char(i, kind=1)) /= i) call abort
50
  if (ichar(char(i, kind=4)) /= i) call abort
51
 
52
end subroutine test
53
 
54
subroutine test_bis (s4, i, i2, i4)
55
  character(kind=4,len=1) :: s4
56
  integer :: i, i2, i4
57
 
58
  if (i /= i2) call abort
59
  if (i /= i4) call abort
60
 
61
  if (iachar (s4) /= i) call abort
62
  if (ichar (s4) /= i) call abort
63
  if (achar(i, kind=4) /= s4) call abort
64
  if (char(i, kind=4) /= s4) call abort
65
  if (iachar(achar(i, kind=4)) /= i) call abort
66
  if (ichar(char(i, kind=4)) /= i) call abort
67
 
68
end subroutine test_bis
69
 
70
end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.