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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [widechar_intrinsics_4.f90] - Blame information for rev 774

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-options "-fbackslash" }
3
 
4
  character(kind=1,len=20) :: s1
5
  character(kind=4,len=20) :: s4
6
 
7
  call test_adjust1 ("  foo bar ", 4_"  foo bar ")
8
  s1 = "  foo bar " ; s4 = 4_"  foo bar "
9
  call test_adjust2 (s1, s4)
10
 
11
  call test_adjust1 ("  foo bar \xFF", 4_"  foo bar \xFF")
12
  s1 = "  foo bar \xFF" ; s4 = 4_"  foo bar \xFF"
13
  call test_adjust2 (s1, s4)
14
 
15
  call test_adjust1 ("\0  foo bar \xFF", 4_"\0  foo bar \xFF")
16
  s1 = "\0  foo bar \xFF" ; s4 = 4_"\0  foo bar \xFF"
17
  call test_adjust2 (s1, s4)
18
 
19
  s4 = "\0  foo bar \xFF"
20
  if (adjustl (s4) /= adjustl (4_"\0  foo bar \xFF        ")) call abort
21
  if (adjustr (s4) /= adjustr (4_"\0  foo bar \xFF        ")) call abort
22
 
23
  s4 = "   \0  foo bar \xFF"
24
  if (adjustl (s4) /= adjustl (4_"   \0  foo bar \xFF     ")) call abort
25
  if (adjustr (s4) /= adjustr (4_"   \0  foo bar \xFF     ")) call abort
26
 
27
  s4 = 4_" \U12345678\xeD bar \ufd30"
28
  if (adjustl (s4) /= &
29
      adjustl (4_" \U12345678\xeD bar \ufd30           ")) call abort
30
  if (adjustr (s4) /= &
31
      adjustr (4_" \U12345678\xeD bar \ufd30           ")) call abort
32
 
33
contains
34
 
35
  subroutine test_adjust1 (s1, s4)
36
 
37
    character(kind=1,len=*) :: s1
38
    character(kind=4,len=*) :: s4
39
 
40
    character(kind=1,len=len(s4)) :: t1
41
    character(kind=4,len=len(s1)) :: t4
42
 
43
    if (len(s1) /= len(s4)) call abort
44
    if (len(t1) /= len(t4)) call abort
45
 
46
    if (len_trim(s1) /= len_trim (s4)) call abort
47
 
48
    t1 = adjustl (s4)
49
    t4 = adjustl (s1)
50
    if (t1 /= adjustl (s1)) call abort
51
    if (t4 /= adjustl (s4)) call abort
52
    if (len_trim (t1) /= len_trim (t4)) call abort
53
    if (len_trim (adjustl (s1)) /= len_trim (t4)) call abort
54
    if (len_trim (adjustl (s4)) /= len_trim (t1)) call abort
55
 
56
    if (len_trim (t1) /= len (trim (t1))) call abort
57
    if (len_trim (s1) /= len (trim (s1))) call abort
58
    if (len_trim (t4) /= len (trim (t4))) call abort
59
    if (len_trim (s4) /= len (trim (s4))) call abort
60
 
61
    t1 = adjustr (s4)
62
    t4 = adjustr (s1)
63
    if (t1 /= adjustr (s1)) call abort
64
    if (t4 /= adjustr (s4)) call abort
65
    if (len_trim (t1) /= len_trim (t4)) call abort
66
    if (len_trim (adjustr (s1)) /= len_trim (t4)) call abort
67
    if (len_trim (adjustr (s4)) /= len_trim (t1)) call abort
68
    if (len (t1) /= len_trim (t1)) call abort
69
    if (len (t4) /= len_trim (t4)) call abort
70
 
71
    if (len_trim (t1) /= len (trim (t1))) call abort
72
    if (len_trim (s1) /= len (trim (s1))) call abort
73
    if (len_trim (t4) /= len (trim (t4))) call abort
74
    if (len_trim (s4) /= len (trim (s4))) call abort
75
 
76
  end subroutine test_adjust1
77
 
78
  subroutine test_adjust2 (s1, s4)
79
 
80
    character(kind=1,len=20) :: s1
81
    character(kind=4,len=20) :: s4
82
 
83
    character(kind=1,len=len(s4)) :: t1
84
    character(kind=4,len=len(s1)) :: t4
85
 
86
    if (len(s1) /= len(s4)) call abort
87
    if (len(t1) /= len(t4)) call abort
88
 
89
    if (len_trim(s1) /= len_trim (s4)) call abort
90
 
91
    t1 = adjustl (s4)
92
    t4 = adjustl (s1)
93
    if (t1 /= adjustl (s1)) call abort
94
    if (t4 /= adjustl (s4)) call abort
95
    if (len_trim (t1) /= len_trim (t4)) call abort
96
    if (len_trim (adjustl (s1)) /= len_trim (t4)) call abort
97
    if (len_trim (adjustl (s4)) /= len_trim (t1)) call abort
98
 
99
    if (len_trim (t1) /= len (trim (t1))) call abort
100
    if (len_trim (s1) /= len (trim (s1))) call abort
101
    if (len_trim (t4) /= len (trim (t4))) call abort
102
    if (len_trim (s4) /= len (trim (s4))) call abort
103
 
104
    t1 = adjustr (s4)
105
    t4 = adjustr (s1)
106
    if (t1 /= adjustr (s1)) call abort
107
    if (t4 /= adjustr (s4)) call abort
108
    if (len_trim (t1) /= len_trim (t4)) call abort
109
    if (len_trim (adjustr (s1)) /= len_trim (t4)) call abort
110
    if (len_trim (adjustr (s4)) /= len_trim (t1)) call abort
111
    if (len (t1) /= len_trim (t1)) call abort
112
    if (len (t4) /= len_trim (t4)) call abort
113
 
114
    if (len_trim (t1) /= len (trim (t1))) call abort
115
    if (len_trim (s1) /= len (trim (s1))) call abort
116
    if (len_trim (t4) /= len (trim (t4))) call abort
117
    if (len_trim (s4) /= len (trim (s4))) call abort
118
 
119
  end subroutine test_adjust2
120
 
121
end

powered by: WebSVN 2.1.0

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