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 848

Go to most recent revision | Details | Compare with Previous | View Log


! { 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

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`

Browse

Tools

Subversion Repositories openrisc

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