gcc/testsuite/gfortran.dg/realloc_on_assign_1.f03

   1 ! { dg-do run }
   2 ! Tests the patch that implements F2003 automatic allocation and
   3 ! reallocation of allocatable arrays on assignment.
   4 !
   5 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   6 !
   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"]
  13
  14   allocate(a(1))
  15   mat = reshape (src, [2,2])
  16
  17   a = [4,3,2,1]
  18   if (size(a, 1) .ne. 4) STOP 1
  19   if (any (a .ne. [4,3,2,1])) STOP 2
  20
  21   a = [((42 - i), i = 1, 10)]
  22   if (size(a, 1) .ne. 10) STOP 3
  23   if (any (a .ne. [((42 - i), i = 1, 10)])) STOP 4
  24
  25   b = a
  26   if (size(b, 1) .ne. 10) STOP 5
  27   if (any (b .ne. a)) STOP 6
  28
  29   a = [4,3,2,1]
  30   if (size(a, 1) .ne. 4) STOP 7
  31   if (any (a .ne. [4,3,2,1])) STOP 8
  32
  33   a = b
  34   if (size(a, 1) .ne. 10) STOP 9
  35   if (any (a .ne. [((42 - i), i = 1, 10)])) STOP 10
  36
  37   j = 20
  38   a = [(i, i = 1, j)]
  39   if (size(a, 1) .ne. j) STOP 11
  40   if (any (a .ne. [(i, i = 1, j)])) STOP 12
  41
  42   a = foo (15)
  43   if (size(a, 1) .ne. 15) STOP 13
  44   if (any (a .ne. [((i + 15), i = 1, 15)])) STOP 14
  45
  46   a = src
  47   if (lbound(a, 1) .ne. lbound(src, 1)) STOP 15
  48   if (ubound(a, 1) .ne. ubound(src, 1)) STOP 16
  49   if (any (a .ne. [11,12,13,14])) STOP 17
  50
  51   k = 7
  52   a = b(k:8)
  53   if (lbound(a, 1) .ne. lbound (b(k:8), 1)) STOP 18
  54   if (ubound(a, 1) .ne. ubound (b(k:8), 1)) STOP 19
  55   if (any (a .ne. [35,34])) STOP 20
  56
  57   c = mat
  58   if (any (lbound (c) .ne. lbound (mat))) STOP 21
  59   if (any (ubound (c) .ne. ubound (mat))) STOP 22
  60   if (any (c .ne. mat)) STOP 23
  61
  62   deallocate (c)
  63   c = mat(2:,:)
  64   if (any (lbound (c) .ne. lbound (mat(2:,:)))) STOP 24
  65
  66   chr1 = chr2(2:1:-1)
  67   if (lbound(chr1, 1) .ne. 1) STOP 25
  68   if (any (chr1 .ne. chr2(2:1:-1))) STOP 26
  69
  70   b = c(1, :) + c(2, :)
  71   if (lbound(b, 1) .ne. lbound (c(1, :) + c(2, :), 1)) STOP 27
  72   if (any (b .ne. c(1, :) + c(2, :))) STOP 28
  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