[C++ PATCH] Deprecate -ffriend-injection
[official-gcc.git] / gcc / testsuite / gfortran.dg / realloc_on_assign_1.f03
blobe80084d97f20be6eed2aad31f3c2d3c48ab8956f
1 ! { dg-do run }
2 ! Tests the patch that implements F2003 automatic allocation and
3 ! reallocation of allocatable arrays on assignment.
5 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
7   integer(4), allocatable :: a(:), b(:), c(:,:)
8   integer(4) :: j
9   integer(4) :: src(2:5) = [11,12,13,14]
10   integer(4) :: mat(2:3,5:6)
11   character(4), allocatable :: chr1(:)
12   character(4) :: chr2(2) = ["abcd", "wxyz"]
14   allocate(a(1))
15   mat = reshape (src, [2,2])
17   a = [4,3,2,1]
18   if (size(a, 1) .ne. 4) call abort
19   if (any (a .ne. [4,3,2,1])) call abort
21   a = [((42 - i), i = 1, 10)]
22   if (size(a, 1) .ne. 10) call abort
23   if (any (a .ne. [((42 - i), i = 1, 10)])) call abort
25   b = a
26   if (size(b, 1) .ne. 10) call abort
27   if (any (b .ne. a)) call abort
29   a = [4,3,2,1]
30   if (size(a, 1) .ne. 4) call abort
31   if (any (a .ne. [4,3,2,1])) call abort
33   a = b
34   if (size(a, 1) .ne. 10) call abort
35   if (any (a .ne. [((42 - i), i = 1, 10)])) call abort
37   j = 20
38   a = [(i, i = 1, j)]
39   if (size(a, 1) .ne. j) call abort
40   if (any (a .ne. [(i, i = 1, j)])) call abort
42   a = foo (15)
43   if (size(a, 1) .ne. 15) call abort
44   if (any (a .ne. [((i + 15), i = 1, 15)])) call abort
46   a = src
47   if (lbound(a, 1) .ne. lbound(src, 1)) call abort
48   if (ubound(a, 1) .ne. ubound(src, 1)) call abort
49   if (any (a .ne. [11,12,13,14])) call abort
51   k = 7
52   a = b(k:8)
53   if (lbound(a, 1) .ne. lbound (b(k:8), 1)) call abort
54   if (ubound(a, 1) .ne. ubound (b(k:8), 1)) call abort
55   if (any (a .ne. [35,34])) call abort
57   c = mat
58   if (any (lbound (c) .ne. lbound (mat))) call abort
59   if (any (ubound (c) .ne. ubound (mat))) call abort
60   if (any (c .ne. mat)) call abort
62   deallocate (c)
63   c = mat(2:,:)
64   if (any (lbound (c) .ne. lbound (mat(2:,:)))) call abort
66   chr1 = chr2(2:1:-1)
67   if (lbound(chr1, 1) .ne. 1) call abort
68   if (any (chr1 .ne. chr2(2:1:-1))) call abort
70   b = c(1, :) + c(2, :)
71   if (lbound(b, 1) .ne. lbound (c(1, :) + c(2, :), 1)) call abort
72   if (any (b .ne. c(1, :) + c(2, :))) call abort
73 contains
74   function foo (n) result(res)
75     integer(4), allocatable, dimension(:) :: res
76     integer(4) :: n
77     allocate (res(n))
78     res = [((i + 15), i = 1, n)]
79   end function foo
80 end