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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! PR 17792
3
! PR 21375
4
! Test that the STAT argument to DEALLOCATE works with POINTERS and
5
! ALLOCATABLE arrays.
6
program deallocate_stat
7
 
8
   implicit none
9
 
10
   integer i
11
   real, pointer :: a1(:), a2(:,:), a3(:,:,:), a4(:,:,:,:), &
12
   &  a5(:,:,:,:,:), a6(:,:,:,:,:,:), a7(:,:,:,:,:,:,:)
13
 
14
   real, allocatable :: b1(:), b2(:,:), b3(:,:,:), b4(:,:,:,:), &
15
   &  b5(:,:,:,:,:), b6(:,:,:,:,:,:), b7(:,:,:,:,:,:,:)
16
 
17
   allocate(a1(2), a2(2,2), a3(2,2,2), a4(2,2,2,2), a5(2,2,2,2,2))
18
   allocate(a6(2,2,2,2,2,2), a7(2,2,2,2,2,2,2))
19
 
20
   a1 = 1. ; a2 = 2. ; a3 = 3. ; a4 = 4. ; a5 = 5. ; a6 = 6. ; a7 = 7.
21
 
22
   i = 13
23
   deallocate(a1, stat=i) ; if (i /= 0) call abort
24
   deallocate(a2, stat=i) ; if (i /= 0) call abort
25
   deallocate(a3, stat=i) ; if (i /= 0) call abort
26
   deallocate(a4, stat=i) ; if (i /= 0) call abort
27
   deallocate(a5, stat=i) ; if (i /= 0) call abort
28
   deallocate(a6, stat=i) ; if (i /= 0) call abort
29
   deallocate(a7, stat=i) ; if (i /= 0) call abort
30
 
31
   i = 14
32
   deallocate(a1, stat=i) ; if (i /= 1) call abort
33
   deallocate(a2, stat=i) ; if (i /= 1) call abort
34
   deallocate(a3, stat=i) ; if (i /= 1) call abort
35
   deallocate(a4, stat=i) ; if (i /= 1) call abort
36
   deallocate(a5, stat=i) ; if (i /= 1) call abort
37
   deallocate(a6, stat=i) ; if (i /= 1) call abort
38
   deallocate(a7, stat=i) ; if (i /= 1) call abort
39
 
40
   allocate(b1(2), b2(2,2), b3(2,2,2), b4(2,2,2,2), b5(2,2,2,2,2))
41
   allocate(b6(2,2,2,2,2,2), b7(2,2,2,2,2,2,2))
42
 
43
   b1 = 1. ; b2 = 2. ; b3 = 3. ; b4 = 4. ; b5 = 5. ; b6 = 6. ; b7 = 7.
44
 
45
   i = 13
46
   deallocate(b1, stat=i) ; if (i /= 0) call abort
47
   deallocate(b2, stat=i) ; if (i /= 0) call abort
48
   deallocate(b3, stat=i) ; if (i /= 0) call abort
49
   deallocate(b4, stat=i) ; if (i /= 0) call abort
50
   deallocate(b5, stat=i) ; if (i /= 0) call abort
51
   deallocate(b6, stat=i) ; if (i /= 0) call abort
52
   deallocate(b7, stat=i) ; if (i /= 0) call abort
53
 
54
   i = 14
55
   deallocate(b1, stat=i) ; if (i /= 1) call abort
56
   deallocate(b2, stat=i) ; if (i /= 1) call abort
57
   deallocate(b3, stat=i) ; if (i /= 1) call abort
58
   deallocate(b4, stat=i) ; if (i /= 1) call abort
59
   deallocate(b5, stat=i) ; if (i /= 1) call abort
60
   deallocate(b6, stat=i) ; if (i /= 1) call abort
61
   deallocate(b7, stat=i) ; if (i /= 1) call abort
62
 
63
 
64
   allocate(a1(2), a2(2,2), a3(2,2,2), b4(2,2,2,2), b5(2,2,2,2,2))
65
   allocate(b6(2,2,2,2,2,2))
66
 
67
   a1 = 1. ; a2 = 2. ; a3 = 3. ; b4 = 4. ; b5 = 5. ; b6 = 6.
68
 
69
   i = 13
70
   deallocate(a1, stat=i) ;         if (i /= 0) call abort
71
   deallocate(a2, a1, stat=i) ;     if (i /= 1) call abort
72
   deallocate(a1, a3, a2, stat=i) ; if (i /= 1) call abort
73
   deallocate(b4, stat=i) ;         if (i /= 0) call abort
74
   deallocate(b4, b5, stat=i) ;     if (i /= 1) call abort
75
   deallocate(b4, b5, b6, stat=i) ; if (i /= 1) call abort
76
 
77
end program deallocate_stat

powered by: WebSVN 2.1.0

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