diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/class_allocate_1.f03')
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_allocate_1.f03 | 98 |
1 files changed, 98 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_1.f03 b/gcc/testsuite/gfortran.dg/class_allocate_1.f03 new file mode 100644 index 000000000..67c806579 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_1.f03 @@ -0,0 +1,98 @@ +! { dg-do run } +! +! Allocating CLASS variables. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + + implicit none + + type t1 + integer :: comp = 5 + class(t1),pointer :: cc + end type + + type, extends(t1) :: t2 + integer :: j + end type + + type, extends(t2) :: t3 + integer :: k + end type + + class(t1),pointer :: cp, cp2 + type(t2),pointer :: cp3 + type(t3) :: x + integer :: i + + + ! (1) check that vindex is set correctly (for different cases) + + i = 0 + allocate(cp) + select type (cp) + type is (t1) + i = 1 + type is (t2) + i = 2 + type is (t3) + i = 3 + end select + deallocate(cp) + if (i /= 1) call abort() + + i = 0 + allocate(t2 :: cp) + select type (cp) + type is (t1) + i = 1 + type is (t2) + i = 2 + type is (t3) + i = 3 + end select + deallocate(cp) + if (i /= 2) call abort() + + i = 0 + allocate(cp, source = x) + select type (cp) + type is (t1) + i = 1 + type is (t2) + i = 2 + type is (t3) + i = 3 + end select + deallocate(cp) + if (i /= 3) call abort() + + i = 0 + allocate(t2 :: cp2) + allocate(cp, source = cp2) + allocate(t2 :: cp3) + allocate(cp, source=cp3) + select type (cp) + type is (t1) + i = 1 + type is (t2) + i = 2 + type is (t3) + i = 3 + end select + deallocate(cp) + deallocate(cp2) + if (i /= 2) call abort() + + + ! (2) check initialization (default initialization vs. SOURCE) + + allocate(cp) + if (cp%comp /= 5) call abort() + deallocate(cp) + + x%comp = 4 + allocate(cp, source=x) + if (cp%comp /= 4) call abort() + deallocate(cp) + +end |