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) call abort
  19   if (any (a .ne. [4,3,2,1])) call abort
  20
  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
  24
  25   b = a
  26   if (size(b, 1) .ne. 10) call abort
  27   if (any (b .ne. a)) call abort
  28
  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
  32
  33   a = b
  34   if (size(a, 1) .ne. 10) call abort
  35   if (any (a .ne. [((42 - i), i = 1, 10)])) call abort
  36
  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
  41
  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
  45
  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
  50
  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
  56
  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
  61
  62   deallocate (c)
  63   c = mat(2:,:)
  64   if (any (lbound (c) .ne. lbound (mat(2:,:)))) call abort
  65
  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
  69
  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