diff options
author | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
---|---|---|
committer | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
commit | 1bc5aee63eb72b341f506ad058502cd0361f0d10 (patch) | |
tree | c607e8252f3405424ff15bc2d00aa38dadbb2518 /gcc-4.9/gcc/testsuite/gfortran.dg/class_array_2.f03 | |
parent | 283a0bf58fcf333c58a2a92c3ebbc41fb9eb1fdb (diff) | |
download | toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.gz toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.bz2 toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.zip |
Initial checkin of GCC 4.9.0 from trunk (r208799).
Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg/class_array_2.f03')
-rw-r--r-- | gcc-4.9/gcc/testsuite/gfortran.dg/class_array_2.f03 | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_2.f03 b/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_2.f03 new file mode 100644 index 000000000..68f1b71e5 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/class_array_2.f03 @@ -0,0 +1,78 @@ +! { dg-do run } +! +! Test functionality of pointer class arrays: +! ALLOCATE with source, ASSOCIATED, DEALLOCATE, passing as arguments for +! ELEMENTAL and non-ELEMENTAL procedures, SELECT TYPE and LOWER/UPPER. +! + type :: type1 + integer :: i + end type + type, extends(type1) :: type2 + real :: r + end type + class(type1), pointer, dimension (:) :: x + + allocate(x(2), source = type2(42,42.0)) + call display(x, [1], [2], t2 = [type2(42,42.0),type2(42,42.0)]) + call display(x, [1], [2], t2 = [type2(111,99.0),type2(111,99.0)]) + if (associated (x)) deallocate (x) + + allocate(x(1:4), source = [(type2(i,42.0 + float (i)), i = 1, 4)]) + call display(x, [1], [4], t2 = [(type2(i,42.0 + float (i)), i = 1, 4)]) + call display(x, [1], [4], t2 = [(type2(111,99.0), i = 1, 4)]) + + if (any (disp (x) .ne. [99.0,99.0,99.0,99.0])) call abort + + if (associated (x)) deallocate (x) + + allocate(x(1:4), source = type1(42)) + call display(x, [1], [4], t1 = [(type1(42), i = 1, 4)]) + call display(x, [1], [4], t1 = [type1(42),type1(99),type1(42),type1(42)]) + if (any (disp (x) .ne. [0.0,0.0,0.0,0.0])) call abort + + if (associated (x)) deallocate (x) + +contains + subroutine display(x, lower, upper, t1, t2) + class(type1), pointer, dimension (:) :: x + integer, dimension (:) :: lower, upper + type(type1), optional, dimension(:) :: t1 + type(type2), optional, dimension(:) :: t2 + select type (x) + type is (type1) + if (present (t1)) then + if (any (x%i .ne. t1%i)) call abort + else + call abort + end if + x(2)%i = 99 + type is (type2) + if (present (t2)) then + if (any (x%i .ne. t2%i)) call abort + if (any (x%r .ne. t2%r)) call abort + else + call abort + end if + x%i = 111 + x%r = 99.0 + end select + call bounds (x, lower, upper) + end subroutine + subroutine bounds (x, lower, upper) + class(type1), pointer, dimension (:) :: x + integer, dimension (:) :: lower, upper + if (any (lower .ne. lbound (x))) call abort + if (any (upper .ne. ubound (x))) call abort + end subroutine + elemental function disp(y) result(ans) + class(type1), intent(in) :: y + real :: ans + select type (y) + type is (type1) + ans = 0.0 + type is (type2) + ans = y%r + end select + end function +end + |