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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [widechar_intrinsics_5.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
  implicit none
5
  integer :: i, j
6
  character(kind=4,len=5), dimension(3,3), parameter :: &
7
    p = reshape([4_" \xFF   ", 4_"\0    ", 4_" foo ", &
8
                 4_"\u1230\uD67Bde\U31DC8B30", 4_"     ", 4_"fa fe", &
9
                 4_"     ", 4_"foo  ", 4_"nul\0l"], [3,3])
10
 
11
  character(kind=4,len=5), dimension(3,3) :: m1
12
  character(kind=4,len=5), allocatable, dimension(:,:) :: m2
13
 
14
  if (kind (p) /= 4) call abort
15
  if (kind (m1) /= 4) call abort
16
  if (kind (m2) /= 4) call abort
17
 
18
  m1 = reshape (p, [3,3])
19
 
20
  allocate (m2(3,3))
21
  m2(:,:) = reshape (m1, [3,3])
22
 
23
  if (any (m1 /= p)) call abort
24
  if (any (m2 /= p)) call abort
25
 
26
  if (size (p) /= 9) call abort
27
  if (size (m1) /= 9) call abort
28
  if (size (m2) /= 9) call abort
29
  if (size (p,1) /= 3) call abort
30
  if (size (m1,1) /= 3) call abort
31
  if (size (m2,1) /= 3) call abort
32
  if (size (p,2) /= 3) call abort
33
  if (size (m1,2) /= 3) call abort
34
  if (size (m2,2) /= 3) call abort
35
 
36
  call check_shape (p, (/3,3/), 5)
37
  call check_shape (p, shape(p), 5)
38
  call check_shape (m1, (/3,3/), 5)
39
  call check_shape (m1, shape(m1), 5)
40
  call check_shape (m1, (/3,3/), 5)
41
  call check_shape (m1, shape(m1), 5)
42
 
43
  deallocate (m2)
44
 
45
 
46
  allocate (m2(3,4))
47
  m2 = reshape (m1, [3,4], p)
48
  if (any (m2(1:3,1:3) /= p)) call abort
49
  if (any (m2(1:3,4) /= m1(1:3,1))) call abort
50
  call check_shape (m2, (/3,4/), 5)
51
  deallocate (m2)
52
 
53
  allocate (m2(3,3))
54
  do i = 1, 3
55
    do j = 1, 3
56
      m2(i,j) = m1(i,j)
57
    end do
58
  end do
59
 
60
  m2 = transpose(m2)
61
  if (any(transpose(p) /= m2)) call abort
62
  if (any(transpose(m1) /= m2)) call abort
63
  if (any(transpose(m2) /= p)) call abort
64
  if (any(transpose(m2) /= m1)) call abort
65
 
66
  m1 = transpose(p)
67
  if (any(transpose(p) /= m2)) call abort
68
  if (any(m1 /= m2)) call abort
69
  if (any(transpose(m2) /= p)) call abort
70
  if (any(transpose(m2) /= transpose(m1))) call abort
71
  deallocate (m2)
72
 
73
  allocate (m2(3,3))
74
  m2 = p
75
  m1 = m2
76
  if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort
77
  if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort
78
  if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort
79
  deallocate (m2)
80
 
81
  allocate (m2(3,3))
82
  m2 = p
83
  m1 = m2
84
  if (any (pack (p, p /= 4_"") /= [4_" \xFF   ", 4_"\0    ", 4_" foo ", &
85
                                   4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
86
                                   4_"foo  ", 4_"nul\0l"])) call abort
87
  if (any (len_trim (pack (p, p /= 4_"")) /= [2,1,4,5,5,3,5])) call abort
88
  if (any (pack (m1, m1 /= 4_"") /= [4_" \xFF   ", 4_"\0    ", 4_" foo ", &
89
                                   4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
90
                                   4_"foo  ", 4_"nul\0l"])) call abort
91
  if (any (len_trim (pack (m1, m1 /= 4_"")) /= [2,1,4,5,5,3,5])) call abort
92
  if (any (pack (m2, m2 /= 4_"") /= [4_" \xFF   ", 4_"\0    ", 4_" foo ", &
93
                                   4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
94
                                   4_"foo  ", 4_"nul\0l"])) call abort
95
  if (any (len_trim (pack (m2, m2 /= 4_"")) /= [2,1,4,5,5,3,5])) call abort
96
  deallocate (m2)
97
 
98
  allocate (m2(1,7))
99
  m2 = reshape ([4_" \xFF   ", 4_"\0    ", 4_" foo ", &
100
                 4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
101
                 4_"foo  ", 4_"nul\0l"], [1,7])
102
  m1 = p
103
  if (any (unpack(m2(1,:), p /= 4_"", 4_"     ") /= p)) call abort
104
  if (any (unpack(m2(1,:), m1 /= 4_"", 4_"     ") /= m1)) call abort
105
  deallocate (m2)
106
 
107
contains
108
 
109
  subroutine check_shape (array, res, l)
110
    character(kind=4,len=*), dimension(:,:) :: array
111
    integer, dimension(:) :: res
112
    integer :: l
113
 
114
    if (kind (array) /= 4) call abort
115
    if (len(array) /= l) call abort
116
 
117
    if (size (res) /= size (shape (array))) call abort
118
    if (any (shape (array) /= res)) call abort
119
  end subroutine check_shape
120
 
121
end

powered by: WebSVN 2.1.0

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