3 ! Test contributed by Thomas L. Clune via pr60322
4 ! and Antony Lewis via pr64692
12 type(foo), dimension(2:3) :: arg
14 integer :: twoDarr(2,3)
16 double precision :: P(2, 2)
18 ! Checking for PR/60322
19 call copyFromClassArray([Foo(), Foo()])
20 call copyFromClassArray(arg)
21 call copyFromClassArray(arg(:))
30 twoDarr = reshape([3, 4, 5, 5, 6, 7], [2, 3])
32 call WtwoD(reshape([3, 4, 5, 5, 6, 7], [2, 3]))
34 ! Checking for PR/64692
35 P(1:2, 1) = [1.d0, 2.d0]
36 P(1:2, 2) = [3.d0, 4.d0]
37 call AddArray(P(1:2, 2))
41 subroutine copyFromClassArray(classarray)
42 class (Foo), intent(in) :: classarray(:)
44 if (lbound(classarray, 1) .ne. 1) call abort()
45 if (ubound(classarray, 1) .ne. 2) call abort()
46 if (size(classarray) .ne. 2) call abort()
49 subroutine AddArray(P)
50 class(*), target, intent(in) :: P(:)
51 class(*), pointer :: Pt(:)
53 allocate(Pt(1:size(P)), source= P)
56 type is (double precision)
57 if (abs(P(1)-3.d0) .gt. 1.d-8) call abort()
58 if (abs(P(2)-4.d0) .gt. 1.d-8) call abort()
64 type is (double precision)
65 if (abs(Pt(1)-3.d0) .gt. 1.d-8) call abort()
66 if (abs(Pt(2)-4.d0) .gt. 1.d-8) call abort()
73 class(*), intent(in) :: ar(:)
75 if (lbound(ar, 1) /= 1) call abort()
78 ! The indeces 1:2 are essential here, or else one would not
79 ! note, that the array internally starts at 0, although the
80 ! check for the lbound above went fine.
81 if (any (ar(1:2) .ne. [3, 4])) call abort()
88 class(*), intent(in) :: ar(:,:)
90 if (any (lbound(ar) /= [1, 1])) call abort()
93 if (any (reshape(ar(1:2,1:3), [6]) .ne. [3, 4, 5, 5, 6, 7])) &
99 end program class_array_20