URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [realloc_on_assign_1.f03] - Rev 694
Compare with Previous | Blame | View Log
! { dg-do run }! Tests the patch that implements F2003 automatic allocation and! reallocation of allocatable arrays on assignment.!! Contributed by Paul Thomas <pault@gcc.gnu.org>!integer(4), allocatable :: a(:), b(:), c(:,:)integer(4) :: jinteger(4) :: src(2:5) = [11,12,13,14]integer(4) :: mat(2:3,5:6)character(4), allocatable :: chr1(:)character(4) :: chr2(2) = ["abcd", "wxyz"]allocate(a(1))mat = reshape (src, [2,2])a = [4,3,2,1]if (size(a, 1) .ne. 4) call abortif (any (a .ne. [4,3,2,1])) call aborta = [((42 - i), i = 1, 10)]if (size(a, 1) .ne. 10) call abortif (any (a .ne. [((42 - i), i = 1, 10)])) call abortb = aif (size(b, 1) .ne. 10) call abortif (any (b .ne. a)) call aborta = [4,3,2,1]if (size(a, 1) .ne. 4) call abortif (any (a .ne. [4,3,2,1])) call aborta = bif (size(a, 1) .ne. 10) call abortif (any (a .ne. [((42 - i), i = 1, 10)])) call abortj = 20a = [(i, i = 1, j)]if (size(a, 1) .ne. j) call abortif (any (a .ne. [(i, i = 1, j)])) call aborta = foo (15)if (size(a, 1) .ne. 15) call abortif (any (a .ne. [((i + 15), i = 1, 15)])) call aborta = srcif (lbound(a, 1) .ne. lbound(src, 1)) call abortif (ubound(a, 1) .ne. ubound(src, 1)) call abortif (any (a .ne. [11,12,13,14])) call abortk = 7a = b(k:8)if (lbound(a, 1) .ne. lbound (b(k:8), 1)) call abortif (ubound(a, 1) .ne. ubound (b(k:8), 1)) call abortif (any (a .ne. [35,34])) call abortc = matif (any (lbound (c) .ne. lbound (mat))) call abortif (any (ubound (c) .ne. ubound (mat))) call abortif (any (c .ne. mat)) call abortdeallocate (c)c = mat(2:,:)if (any (lbound (c) .ne. lbound (mat(2:,:)))) call abortchr1 = chr2(2:1:-1)if (lbound(chr1, 1) .ne. 1) call abortif (any (chr1 .ne. chr2(2:1:-1))) call abortb = c(1, :) + c(2, :)if (lbound(b, 1) .ne. lbound (c(1, :) + c(2, :), 1)) call abortif (any (b .ne. c(1, :) + c(2, :))) call abortcontainsfunction foo (n) result(res)integer(4), allocatable, dimension(:) :: resinteger(4) :: nallocate (res(n))res = [((i + 15), i = 1, n)]end function fooend
