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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [equiv_init_1.f90] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
! Program to test initialization of equivalence blocks.  PR13742.
2
! Some forms are not yet implemented.  These are indicated by !!$
3
 
4
subroutine test0s
5
  character*10 :: x = "abcdefghij"
6
  character*10 :: y
7
  equivalence (x,y)
8
 
9
  character*10 :: xs(10)
10
  character*10 :: ys(10)
11
  equivalence (xs,ys)
12
  data xs /10*"abcdefghij"/
13
 
14
  if (y.ne."abcdefghij") call abort
15
  if (ys(1).ne."abcdefghij") call abort
16
  if (ys(10).ne."abcdefghij") call abort
17
end
18
 
19
subroutine test0
20
  integer :: x = 123
21
  integer :: y
22
  equivalence (x,y)
23
  if (y.ne.123) call abort
24
end
25
 
26
subroutine test1
27
  integer :: a(3)
28
  integer :: x = 1
29
  integer :: y
30
  integer :: z = 3
31
  equivalence (a(1), x)
32
  equivalence (a(3), z)
33
  if (x.ne.1) call abort
34
  if (z.ne.3) call abort
35
  if (a(1).ne.1) call abort
36
  if (a(3).ne.3) call abort
37
end
38
 
39
subroutine test2
40
  integer :: x
41
  integer :: z
42
  integer :: a(3) = 123
43
  equivalence (a(1), x)
44
  equivalence (a(3), z)
45
  if (x.ne.123) call abort
46
  if (z.ne.123) call abort
47
end
48
 
49
subroutine test3
50
  integer :: x
51
!!$  integer :: y = 2
52
  integer :: z
53
  integer :: a(3)
54
  equivalence (a(1),x), (a(2),y), (a(3),z)
55
  data a(1) /1/, a(3) /3/
56
  if (x.ne.1) call abort
57
!!$  if (y.ne.2) call abort
58
  if (z.ne.3) call abort
59
end
60
 
61
subroutine test4
62
  integer a(2)
63
  integer b(2)
64
  integer c
65
  equivalence (a(2),b(1)), (b(2),c)
66
  data a/1,2/
67
  data c/3/
68
  if (b(1).ne.2) call abort
69
  if (b(2).ne.3) call abort
70
end
71
 
72
!!$subroutine test5
73
!!$  integer a(2)
74
!!$  integer b(2)
75
!!$  integer c
76
!!$  equivalence (a(2),b(1)), (b(2),c)
77
!!$  data a(1)/1/
78
!!$  data b(1)/2/
79
!!$  data c/3/
80
!!$  if (a(2).ne.2) call abort
81
!!$  if (b(2).ne.3) call abort
82
!!$  print *, "Passed test5"
83
!!$end
84
 
85
program main
86
  call test0s
87
  call test0
88
  call test1
89
  call test2
90
  call test3
91
  call test4
92
!!$  call test5
93
end
94
 

powered by: WebSVN 2.1.0

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